#!/usr/bin/perl -w
#
# Copyright (c) 2006, 2007 Michael Schroeder, Novell Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################
#
# The Repository Server
#

BEGIN {
  my ($wd) = $0 =~ m-(.*)/- ;
  $wd ||= '.';
  # FIXME: currently the bs_srcserver makes assumptions on being in a
  # properly set up working dir, e.g. with subdirs 'worker' and
  # 'build'.  Either that is cleaned up or this stays in, for the sake
  # of startproc and others being able to start a bs_srcserver without
  # knowing that it has to be started in the right directory....

  chdir "$wd";
  unshift @INC,  "build";
  unshift @INC,  ".";
}

use POSIX;
use Fcntl qw(:DEFAULT :flock);
BEGIN { Fcntl->import(':seek') unless defined &SEEK_SET; }
use XML::Structured ':bytes';
use Storable ();
use Data::Dumper;
use Digest::MD5 ();
use Digest::SHA ();
use List::Util;
use Symbol;
use Encode;
use JSON::XS ();

use BSConfiguration;
use BSOBS;
use BSRPC ':https';
use BSServer;
use BSUtil;
use BSHTTP;
use BSFileDB;
use BSXML;
use BSVerify;
use BSHandoff;
use Build;
use BSWatcher ':https';
use BSStdServer;
use BSXPath;
use BSXPathKeys;
use BSNotify;
use BSUrlmapper;
use BSRegistryServer;
use BSRedisnotify;
use BSContar;
use BSConSign;

use BSSolv;

use BSRepServer;
use BSRepServer::BuildInfo;
use BSRepServer::Containerinfo;
use BSRepServer::Containertar;
use BSRepServer::Bininfo;
use BSRepServer::Remote;
use BSRepServer::Registry;
use BSRepServer::YMP;
use BSRepServer::DoD;
use BSRepServer::SLSA;
use BSDispatcher::Constraints;
use BSCando;

# configure Build module for buildinfo queries
$Build::Rpm::unfilteredprereqs = 1 if defined $Build::Rpm::unfilteredprereqs;
$Build::Rpm::conflictdeps = 1 if defined $Build::Rpm::conflictdeps;
$Build::Kiwi::repoextras = 1 if defined $Build::Kiwi::repoextras;

use strict;

my $port = 5252;	#'RR'
my $proto = 'http';
$port = $1 if $BSConfig::reposerver =~ /:(\d+)$/;
$proto = $1 if $BSConfig::reposerver =~ /^(https):/;
my $proxy;
$proxy = $BSConfig::proxy if defined($BSConfig::proxy);

BSUtil::set_fdatasync_before_rename() unless $BSConfig::disable_data_sync || $BSConfig::disable_data_sync;

my $historylay = [qw{versrel bcnt srcmd5 rev time duration}];

my $reporoot = "$BSConfig::bsdir/build";
my $workersdir = "$BSConfig::bsdir/workers";
my $jobsdir = "$BSConfig::bsdir/jobs";
my $eventdir = "$BSConfig::bsdir/events";
my $infodir = "$BSConfig::bsdir/info";
my $uploaddir = "$BSConfig::bsdir/upload";
my $rundir = $BSConfig::rundir || "$BSConfig::bsdir/run";
my $registrydir = "$BSConfig::bsdir/registry";
my $extrepodir = "$BSConfig::bsdir/repos";
my $extrepodb = "$BSConfig::bsdir/db/published";

my $ajaxsocket = "$rundir/bs_repserver.ajax";

my @binsufs = @BSOBS::binsufs;
my $binsufsre = join('|', map {"\Q$_\E"} @binsufs);

# XXX read jobs instead?

### TODO: (fs) move to BSUtil
sub jobname {
  my ($prp, $packid) = @_;
  my $job = "$prp/$packid";
  $job =~ s/\//::/g;
  $job = ':'.Digest::MD5::md5_hex($prp).'::'.(length($packid) > 160 ? ':'.Digest::MD5::md5_hex($packid) : $packid) if length($job) > 200;
  return $job;
}

sub readpackstatus {
  my ($prpa) = @_;
  my $psf = BSStdServer::readstr_memoized("$reporoot/$prpa/:packstatus.finished", 1);
  my $ps = BSStdServer::retrieve_memoized("$reporoot/$prpa/:packstatus", 1);
  if (!$ps) {
    # backward compat: try old xml format
    return undef unless -e "$reporoot/$prpa/:packstatus";
    $ps = readxml("$reporoot/$prpa/:packstatus", $BSXML::packstatuslist, 1);
    return undef unless $ps;
    my %packstatus;
    my %packerror;
    for (@{$ps->{'packstatus'} || []}) {
      $packstatus{$_->{'name'}} = $_->{'status'};
      $packerror{$_->{'name'}} = $_->{'error'} if $_->{'error'};
    }
    $ps = {'packstatus' => \%packstatus, 'packerror' => \%packerror};
  }
  if ($psf) {
    for (split("\n", $psf)) {
      my ($code, $packid) = split(' ', $_, 2);
      if ($code eq 'scheduled') {
        my ($job, $details);
        ($packid, $job, $details) = split('/', $packid, 3);
        next unless ($ps->{'packstatus'}->{$packid} || '') eq 'scheduled';
        $ps->{'packerror'}->{$packid} = $details;
      } else {
        next unless ($ps->{'packstatus'}->{$packid} || '') eq 'scheduled';
        $ps->{'packstatus'}->{$packid} = 'finished';
        $ps->{'packerror'}->{$packid} = $code;
      }
    }
  }
  return $ps;
}

sub getbinaryversions {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my $prp = "$projid/$repoid";
  my @bins;
  if (defined $cgi->{'binaries'}) {
    @bins = split(',', $cgi->{'binaries'});
  } else {
    die unless $cgi->{'view'} && $cgi->{'view'} eq 'binaryversions';
    @bins = @{$cgi->{'binary'} || []};
  }
  if ($cgi->{'now'}) {
    my $waited = time() - $cgi->{'now'};
    print "waited $waited seconds to accept call\n" if $waited > 60;
  }
  my $serial;
  $serial = BSWatcher::serialize("$reporoot/$projid/$repoid/$arch") if $BSStdServer::isajax;
  return if $BSStdServer::isajax && !defined $serial;
  my ($pool, $repo) = BSRepServer::setup_pool_with_repo($prp, $arch, $cgi->{'module'});
  my %names = $repo ? $repo->pkgnames() : ();
  @bins = sort keys %names if !@bins && !defined $cgi->{'binaries'};
  my @res;
  my $needscan;
  my $dodurl = $repo->dodurl();
  my $metacache;
  for my $bin (@bins) {
    my $p = $names{$bin};
    if (!$p) {
      push @res, {'name' => $bin, 'error' => 'not available'};
      next;
    }
    my $path = "$reporoot/".$pool->pkg2fullpath($p, $arch);
    my $sizek = $pool->pkg2sizek($p);
    my $hdrmd5 = $pool->pkg2pkgid($p);
    if ($dodurl && $hdrmd5 eq 'd0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0') {
      my @handoff;
      if (defined $cgi->{'binaries'}) {
	@handoff = ('/getbinaryversions', undef, "project=$projid", "repository=$repoid", "arch=$arch", BSRPC::args($cgi, 'nometa', 'binaries', 'module', 'withevr'));
      } else {
	@handoff = ("/build/$projid/$repoid/$arch/_repository", undef, 'view=binaryversions', BSRPC::args($cgi, 'nometa', 'binary', 'module', 'withevr'));
      }
      $path = BSRepServer::DoD::fetchdodbinary("$reporoot/$prp/$arch", $pool, $repo, $p, \@handoff);
      return unless defined $path;
      # TODO: move it out of the loop otherwise the same files might be queried multiple times
      my @s = stat($path);
      if (!@s && $bin =~ /^container:/ && $path =~ /\.tar$/) {
        $hdrmd5 = undef;
      } else {
        $sizek = ($s[7] + 1023) >> 10;
        $hdrmd5 = Build::queryhdrmd5($path);
      }
      $needscan = 1;
    }
    if ($bin =~ /^container:/ && $path =~ /(\.tar(?:\..+)?)$/) {
      my $n = "$bin$1";
      my @s = stat($path);
      @s = BSRepServer::Containertar::stat_container($path) if $1 eq '.tar' && !@s;
      $hdrmd5 = $s[20] if $s[20] && !defined($hdrmd5);
      push @res, {'name' => $n, 'hdrmd5' => $hdrmd5, 'sizek' => (($s[7] + 1023) >> 10)} if @s;
      next;
    }
    if ($path !~ /\.($binsufsre)$/) {
      push @res, {'name' => $bin, 'error' => 'unknown suffix'};
      next;
    }
    my $r = {'name' => "$bin.$1", 'hdrmd5' => $hdrmd5, 'sizek' => $sizek};
    push @res, $r;
    if ($cgi->{'withevr'}) {
      $r->{'evr'} = $pool->pkg2evr($p);
      $r->{'arch'} = $pool->pkg2arch($p);
    }
    next if $cgi->{'nometa'};
    next unless $path =~ s/\.(?:$binsufsre)$//;
    if (!$metacache) {
      $metacache = BSUtil::retrieve("$reporoot/$projid/$repoid/$arch/:full.metacache", 1) || {};
      # we currently don't bother with :full.metacache.merge. this is not a problem, as the
      # cache is not authoritative
    }
    my @s = stat("$path.meta");
    if (@s && $path =~ /([^\/]*$)/) {
	my $mc = $metacache->{$1};
	if ($mc && $mc->[0] eq "$s[9]/$s[7]/$s[1]") {
	    $r->{'metamd5'} = $mc->[1];
	    next;
	}
    }
    local *F;
    if (!open(F, '<', "$path.meta")) {
      next unless open(F, '<', "$path-MD5SUMS.meta");
    }
    my $ctx = Digest::MD5->new;
    $ctx->addfile(*F);
    $r->{'metamd5'} = $ctx->hexdigest();
    close F;
  }
  undef $repo;
  undef $pool;
  BSWatcher::serialize_end($serial) if defined $serial;
  forwardevent($cgi, 'scanrepo', $projid, undef, $repoid, $arch) if $needscan;
  return ({ 'binary' => \@res }, $BSXML::binaryversionlist);
}

sub getpackagebinaryversionlist {
  my ($cgi, $projid, $repoid, $arch, $packids) = @_;
  my $prp = "$projid/$repoid";
  my @res;

  my $code;
  if ($cgi->{'withcode'}) {
    my $ps = readpackstatus("$projid/$repoid/$arch");
    $code = ($ps || {})->{'packstatus'} || {};
  }
  
  my $gbininfo = BSRepServer::read_gbininfo("$reporoot/$prp/$arch", 1);
  my %packids = map {$_ => 1} @{$packids || []};
  if ($code) {
    $gbininfo->{$_} ||= {} for keys %$code;
  }
  for my $packid (sort keys %$gbininfo) {
    next if %packids && !$packids{$packid};
    next if $packid eq '_volatile' && !$packids;
    my $bininfo = $gbininfo->{$packid};
    filtersources_bininfo($bininfo) if $bininfo->{'.nosourceaccess'};
    my @pres;
    for (sort keys %$bininfo) {
      my $bin = $bininfo->{$_};
      next unless exists $bin->{'filename'};
      my $r = { 'name' => $bin->{'filename'} };
      $r->{'hdrmd5'} = $bin->{'hdrmd5'} if $bin->{'hdrmd5'};
      $r->{'leadsigmd5'} = $bin->{'leadsigmd5'} if $bin->{'leadsigmd5'};
      $r->{'md5sum'} = $bin->{'md5sum'} if $bin->{'md5sum'} && (!$cgi->{'view'} || !$cgi->{'withcode'});	# compat: do not add for interconnect
      my $size = (split('/', $bin->{'id'}))[1];
      $r->{'sizek'} = ($size + 512) >> 10;
      push @pres, $r;
    }
    # add nouseforbuild marker for the scheduler
    push @pres, { 'name' => '.nouseforbuild' } if $code && $bininfo->{'.nouseforbuild'};
    push @res, {'package' => $packid, 'binary' => \@pres};
    $res[-1]->{'code'} = $code->{$packid} || 'unknown' if $code;
  }
  return ({ 'binaryversionlist' => \@res }, $BSXML::packagebinaryversionlist);
}

sub calc_bininfocookie {
  my ($prpa) = @_;
  my @s2 = stat("$reporoot/$prpa/:bininfo.merge");
  my @s1 = stat("$reporoot/$prpa/:bininfo");
  my $cookie = @s1 ? "$s1[9]/$s1[7]/$s1[1]" : '0/0/0';
  $cookie .= "+$s2[9]/$s2[7]/$s2[1]" if @s2;
  return $cookie;
}

sub getpackstatus {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my $prp = "$projid/$repoid";

  die("getpackstatus: package filtering is not supported\n") if $cgi->{'package'};
  my $cookie = $cgi->{'withbininfocookie'} ? calc_bininfocookie("$prp/$arch") : undef;
  my $ps = readpackstatus("$prp/$arch");
  $ps = ($ps || {})->{'packstatus'} || {};
  $ps->{'.bininfocookie'} = $cookie if defined $cookie;
  return (BSUtil::tostorable($ps), 'Content-Type: application/octet-stream');
}

sub getgbininfo {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my $prp = "$projid/$repoid";

  die("getgbininfo: package filtering is not supported\n") if $cgi->{'package'};
  my $cookie = $cgi->{'withbininfocookie'} ? calc_bininfocookie("$prp/$arch") : undef;
  my $gbininfo = BSRepServer::read_gbininfo("$reporoot/$prp/$arch", 1, 1);
  if ($cgi->{'withcode'}) {
    my $ps = readpackstatus("$prp/$arch");
    my $code = ($ps || {})->{'packstatus'} || {};
    $gbininfo->{$_}->{'.code'} = $code->{$_} for keys %$code;
  }
  delete $_->{'.bininfo'} for values %$gbininfo;
  $gbininfo->{'.bininfocookie'} = $cookie if defined $cookie;
  return (BSUtil::tostorable($gbininfo), 'Content-Type: application/octet-stream');
}

sub getbinarychecksums {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my $prp = "$projid/$repoid";

  my $r = "$reporoot/$prp/$arch/:repo";
  if ($cgi->{'view'} eq 'binarychecksums' || -s "$r/.newchecksums") {
    my $checksums = BSUtil::retrieve("$r/.checksums", 1) || {};
    my $newchecksums = BSUtil::retrieve("$r/.newchecksums", 1) || {};
    $checksums->{$_} = delete $newchecksums->{$_} for keys %$newchecksums;
    if ($cgi->{'view'} eq 'binarychecksums') {
      my @res = map { {'package' => $_, '_content' => $checksums->{$_}} } sort keys %$checksums;
      return ({ 'binarychecksums' => \@res }, $BSXML::packagebinarychecksums);
    }
    return (BSUtil::tostorable($checksums), 'Content-Type: application/octet-stream');
  }
  my $fd;
  if (!open($fd, '<', "$r/.checksums")) {
    return (BSUtil::tostorable({}), 'Content-Type: application/octet-stream');
  }
  BSWatcher::reply_file($fd, 'Content-Type: application/octet-stream');
  return undef;
}

sub getrepositorystatus {
  my ($cgi, $projid, $repoid, $arch) = @_;

  my $schedulerstate = readschedulerstate($projid, $repoid, $arch);
  my $status = { 'code' => $schedulerstate->{'code'} };
  $status->{'details'} = $schedulerstate->{'details'} if $schedulerstate->{'details'};
  if ($schedulerstate->{'buildid'}) {
    $status->{'buildid'} = $schedulerstate->{'buildid'};
  } elsif ($schedulerstate->{'oldbuildid'}) {
    $status->{'buildid'} = "$schedulerstate->{'oldbuildid'}-inprogress";
  }
  $status->{'dirty'} = 'true' if ($schedulerstate->{'code'} || '') eq 'scheduling' || -e "$reporoot/$projid/$repoid/$arch/:schedulerstate.dirty";
  return ($status, $BSXML::buildstatus);
}

sub getpackagelist_build {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my $view = $cgi->{'view'};
  die "must specify view\n" unless $view;
  return getrepositorystatus($cgi, $projid, $repoid, $arch) if $view eq 'status';
  return getbinarychecksums($cgi, $projid, $repoid, $arch) if $view eq 'binarychecksums' || $view eq 'rawbinarychecksums';
  if ($view eq 'binaryversionscookie') {
    my $cookie = calc_bininfocookie("$projid/$repoid/$arch");
    return { 'cookie' => $cookie }, $BSXML::packagebinaryversionlist;
  }
  $cgi->{'withcode'} = 1 if $view  eq 'binaryversionscode' || $view  eq 'gbininfocode';
  return getgbininfo($cgi, $projid, $repoid, $arch) if $view eq 'gbininfo' || $view eq 'gbininfocode';
  return getpackstatus($cgi, $projid, $repoid, $arch) if $view eq 'packstatus';
  return getpackagebinaryversionlist($cgi, $projid, $repoid, $arch, $cgi->{'package'}) if $view eq 'binaryversions' || $view eq 'binaryversionscode';
  die("unknown view '$view'\n");
}

# the worker thinks that out packagebinaryversionlist contains bogus entries
sub badpackagebinaryversionlist {
  my ($cgi, $projid, $repoid, $arch, $packids) = @_;
  my $dir = "$reporoot/$projid/$repoid/$arch";
  my $gbininfo = BSRepServer::read_gbininfo($dir);
  if ($gbininfo) {
    $packids = [ sort keys %$gbininfo ] unless $packids;
    for my $packid (@$packids) {
      unlink("$dir/$packid/.bininfo");
    }
    unlink("$dir/:bininfo");
    unlink("$dir/:bininfo.merge");
    forwardevent($cgi, 'scanprjbinaries', $projid, $packids->[0], $repoid, $arch);
  }
  return $BSStdServer::return_ok;
}

sub extend_containerannotation {
  my ($annotationxml, $data) = @_;
  my $annotation = BSUtil::fromxml($annotationxml, $BSXML::binannotation, 1);
  # set obsrepositories:/ repo for DoD containers
  if (!$annotation || (!$annotation->{'repo'} && $annotation->{'registry_digest'})) {
    $annotation ||= {};
    $annotation->{'repo'} = [ { 'url' => 'obsrepositories:/' } ];
  }
  # extend annotation with package data
  if ($data) {
    $annotation->{'hdrmd5'} = $data->{'hdrmd5'} if $data->{'hdrmd5'};
    $annotation->{'package'} = $1 if $data->{'path'} && $data->{'path'} =~ /^\.\.\/([^\/]+)\//;
    $annotation->{'epoch'} = $data->{'epoch'} if $data->{'epoch'};
    $annotation->{'version'} = $data->{'version'};
    $annotation->{'release'} = $data->{'release'} if defined $data->{'release'};
    $annotation->{'binaryarch'} = $data->{'arch'} if $data->{'arch'};
  }
  return undef unless %$annotation;
  return BSUtil::toxml($annotation, $BSXML::binannotation);
}

sub getbinaries {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my $prp = "$projid/$repoid";
  my @bins = split(',', $cgi->{'binaries'} || '');
  if ($cgi->{'now'}) {
    my $waited = time() - $cgi->{'now'};
    print "waited $waited seconds to accept call\n" if $waited > 60;
  }
  my $serial;
  $serial = BSWatcher::serialize("$reporoot/$projid/$repoid/$arch") if $BSStdServer::isajax;
  return if $BSStdServer::isajax && !defined $serial;
  my ($pool, $repo) = BSRepServer::setup_pool_with_repo($prp, $arch, $cgi->{'module'});
  my %names = $repo ? $repo->pkgnames() : ();
  my @send;
  my $needscan;
  my $dodurl = $repo->dodurl();
  for my $bin (@bins) {
    my $p = $names{$bin};
    if (!$p) {
      push @send, {'name' => $bin, 'error' => 'not available'};
      next;
    }
    my $path = "$reporoot/".$pool->pkg2fullpath($p, $arch);
    if ($dodurl && $pool->pkg2pkgid($p) eq 'd0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0') {
      my @handoff = ('/getbinaries', undef, "project=$projid", "repository=$repoid", "arch=$arch", BSRPC::args($cgi, 'nometa', 'metaonly', 'binaries', 'module', 'withannotation'));
      $path = BSRepServer::DoD::fetchdodbinary("$reporoot/$prp/$arch", $pool, $repo, $p, \@handoff);
      return unless defined $path;
      $needscan = 1;
    }
    if ($bin =~ /^container:/ && $path =~ /(\.tar(?:\..+)?)$/) {
      next if $cgi->{'metaonly'};
      if ($cgi->{'withannotation'}) {
	my $annotation;
	$annotation = $pool->pkg2annotation($p) if defined &BSSolv::pool::pkg2annotation;
	$annotation = extend_containerannotation($annotation, $pool->pkg2data($p));
	push @send, {'name' => "$bin.annotation", 'data' => $annotation} if $annotation;
      }
      my $n = "$bin$1";
      if ($1 eq '.tar' && ! -e $path) {
	my $fd = BSRepServer::Containertar::open_container($path);
	push @send, {'name' => $n, 'filename' => ($fd || $path)};
	next;
      }
      push @send, {'name' => $n, 'filename' => $path};
      next;
    }
    if ($path !~ /\.($binsufsre)$/) {
      push @send, {'name' => $bin, 'error' => 'unknown suffix'};
      next;
    }
    push @send, {'name' => "$bin.$1", 'filename' => $path} unless $cgi->{'metaonly'};
    next if $cgi->{'nometa'};
    next unless $path =~ s/\.(?:$binsufsre)$//;
    if (-e "$path.meta" || ! -e "$path-MD5SUMS.meta") {
      push @send, {'name' => "$bin.meta", 'filename' => "$path.meta"};
    } else {
      push @send, {'name' => "$bin.meta", 'filename' => "$path-MD5SUMS.meta"};
    }
  }
  undef $repo;
  undef $pool;
  BSWatcher::serialize_end($serial) if defined $serial;
  forwardevent($cgi, 'scanrepo', $projid, undef, $repoid, $arch) if $needscan;
  BSWatcher::reply_cpio(\@send);
  return undef;
}
  
# TODO: move into Build::Rpm
sub getrpmheaders {
  my ($path, $withhdrmd5) = @_;

  my $hdrmd5;
  local *F;
  open(F, '<', $path) || die("$path: $!\n");
  my $buf = '';
  my $l;
  while (length($buf) < 96 + 16) {
    $l = sysread(F, $buf, 4096, length($buf));
    die("$path: read error\n") unless $l;
  }
  die("$path: not a rpm\n") unless unpack('N', $buf) == 0xedabeedb && unpack('@78n', $buf) == 5;
  my ($headmagic, $cnt, $cntdata) = unpack('@96N@104NN', $buf);
  die("$path: not a rpm (bad sig header)\n") unless $headmagic == 0x8eade801 && $cnt < 16384 && $cntdata < 1048576;
  my $hlen = 96 + 16 + $cnt * 16 + $cntdata;
  $hlen = ($hlen + 7) & ~7;
  while (length($buf) < $hlen + 16) {
    $l = sysread(F, $buf, 4096, length($buf));
    die("$path: read error\n") unless $l;
  }
  if ($withhdrmd5) {
    my $idxarea = substr($buf, 96 + 16, $cnt * 16);
    die("$path: no md5 signature header\n") unless $idxarea =~ /\A(?:.{16})*\000\000\003\354\000\000\000\007(....)\000\000\000\020/s;
    my $md5off = unpack('N', $1);
    die("$path: bad md5 offset\n") unless $md5off;
    $md5off += 96 + 16 + $cnt * 16; 
    $hdrmd5 = unpack("\@${md5off}H32", $buf);
  }
  ($headmagic, $cnt, $cntdata) = unpack('N@8NN', substr($buf, $hlen));
  die("$path: not a rpm (bad header)\n") unless $headmagic == 0x8eade801 && $cnt < 1048576 && $cntdata < 33554432;
  my $hlen2 = $hlen + 16 + $cnt * 16 + $cntdata;
  while (length($buf) < $hlen2) {
    $l = sysread(F, $buf, 4096, length($buf));
    die("$path: read error\n") unless $l;
  }
  close F;
  return (substr($buf, 0, 96), substr($buf, 96, $hlen - 96), substr($buf, $hlen, $hlen2 - $hlen), $hdrmd5);
}

sub getavailable {
  my ($projid, $repoid, $arch, $available, $available_pattern, $available_product) = @_;
  my $pool = BSSolv::pool->new();
  my $dir = "$reporoot/$projid/$repoid/$arch/:full";
  my $repo;
  if (-s "$dir.solv") {
    eval {$repo = $pool->repofromfile("$projid/$repoid", "$dir.solv");};
  }
  if ($repo) {
    $pool->createwhatprovides();
    my @pkgs = $repo->pkgnames();
    while (@pkgs) {
      my ($name, $p) = splice(@pkgs, 0, 2);
      my $arch;
      if (defined(&BSSolv::pool::pkg2arch)) {
	$arch = $pool->pkg2arch($p);
      } else {
	my $d = $pool->pkg2data($p);
	$arch = $d->{'arch'};
      }
      $arch ||= 'noarch';
      $available->{$name}->{$arch} = 1;
    }
    for my $p ($pool->whatprovides('pattern()')) {
      my $d = $pool->pkg2data($p);
      my $name;
      my $visible;
      for my $prv (@{$d->{'provides'} || []}) {
	$visible = 1 if $prv =~ /^pattern-visible\(\)/;
        next unless $prv =~ /^pattern\(\) = ([^\.].*)/;
        $name ||= $1;
      }
      $available_pattern->{$name}->{'noarch'} = 1 if $visible && defined $name;
    }
    for my $p ($pool->whatprovides('product()')) {
      my $d = $pool->pkg2data($p);
      my $name;
      for my $prv (@{$d->{'provides'} || []}) {
        next unless $prv =~ /^product\(\) = ([^\.].*)/;
        $name ||= $1;
      }
      $available_product->{$name}->{'noarch'} = 1 if defined $name;
    }
  }
}

sub processavailable {
  my ($available) = @_;
  my %archlist;
  my @res;
  for my $bin (sort keys %$available) {
    my $archlist = join(',', sort keys %{$available->{$bin}});
    $archlist{$archlist}->{$bin} = 1;
  }
  for my $archlist (sort keys %archlist) {
    my @archs = split(',', $archlist);
    push @res, {'arch' => \@archs, 'name' => [ sort keys %{$archlist{$archlist}} ]};
  }
  return \@res;
}

sub utf8_off {
  my ($x) = @_;
  return undef unless defined($x);
  my $r = ref($x);
  if ($r eq '') {
    Encode::_utf8_off($x);
    return $x;
  } elsif ($r eq 'ARRAY') {
    return [ map { utf8_off($_) } @$x ];
  } elsif ($r eq 'HASH') {
    my %h;
    for my $k (keys %$x) {
      Encode::_utf8_off($k);
      $h{$k} = utf8_off($x->{$k});
    }
    return \%h;
  } else {
    return $x;	# hope for the best
  }
}

sub export_annotation {
  my ($annotation_xml) = @_;
  my $annotation = BSUtil::fromxml($annotation_xml, $BSXML::binannotation, 1);
  $annotation = utf8_off($annotation);	# work around XML::Structured bug
  return $annotation unless $annotation && $annotation->{'repo'};
  # map repositories
  for my $r (@{$annotation->{'repo'}}) {
    my $url = $r->{'url'};
    next unless $url;
     my $urlprp;
     if ($url =~ /^obs:\/{1,3}([^\/]+)\/([^\/]+)\/?$/) {
       $urlprp = "$1/$2";
     } else {
       $urlprp = BSUrlmapper::urlmapper($url);
     }
     ($r->{'project'}, $r->{'repository'}) = split('/', $urlprp, 2) if $urlprp;
  }
  return $annotation;
}

# create legacy xml from annotation subset
sub create_legacy_annotation {
  my ($annotation) = @_;
  return undef unless $annotation;
  my %a;
  $a{'repo'} = $annotation->{'repo'} if $annotation->{'repo'};
  $a{'disturl'} = $annotation->{'disturl'} if $annotation->{'disturl'};
  return BSUtil::toxml(\%a, $BSXML::binannotation);
}

sub getbinarylist_repository {
  my ($cgi, $projid, $repoid, $arch) = @_;

  my $prp = "$projid/$repoid";
  my $view = $cgi->{'view'} || '';

  if (($view eq 'cache' || $view eq 'cpio' || $view eq 'solvstate') && !$BSStdServer::isajax && !$cgi->{'noajax'}) {
    my @args = BSRPC::args($cgi, 'view', 'binary', 'module');
    BSHandoff::handoff_part('interconnect_in', "/build/$projid/$repoid/$arch/_repository", undef, @args);
  }

  if ($view eq 'solv') {
    my $fd = gensym;
    if (!open($fd, '<', "$reporoot/$prp/$arch/:full.solv")) {
      my $pool = BSSolv::pool->new();
      my $repo = BSRepServer::addrepo_scan($pool, $prp, $arch);
      if ($repo) {
	$repo->tofile("$reporoot/$prp/$arch/:full.solv.$$");
	if (!open($fd, '<', "$reporoot/$prp/$arch/:full.solv.$$")) {
	  undef $fd;
	}
	unlink("$reporoot/$prp/$arch/:full.solv.$$");
      } else {
        undef $fd;
      }
      undef $repo;
      undef $pool;
    }
    die("no solv file available") unless defined $fd;
    BSWatcher::reply_file($fd);
    return undef;
  }

  if ($view eq 'solvstate') {
    my $repostate = readxml("$reporoot/$prp/$arch/:repostate", $BSXML::repositorystate, 1) || {};
    my @files;
    push @files, {
      'name' => 'repositorystate',
      'data' => XMLout($BSXML::repositorystate, $repostate),
    };
    my $fd = gensym;
    if (open($fd, '<', "$reporoot/$prp/$arch/:full.solv")) {
      push @files, { 'name' => 'repositorysolv', 'filename' => $fd };
    } elsif (-d "$reporoot/$prp/$arch") {
      my $pool = BSSolv::pool->new();
      my $repo = BSRepServer::addrepo_scan($pool, $prp, $arch);
      if ($repo) {
	$repo->tofile("$reporoot/$prp/$arch/:full.solv.$$");
	if (open($fd, '<', "$reporoot/$prp/$arch/:full.solv.$$")) {
          push @files, { 'name' => 'repositorysolv', 'filename' => $fd };
	}
	unlink("$reporoot/$prp/$arch/:full.solv.$$");
      }
      undef $repo;
      undef $pool;
    }
    BSWatcher::reply_cpio(\@files);
    return undef;
  }

  if ($view eq 'cache') {
    my $repostate = readxml("$reporoot/$prp/$arch/:repostate", $BSXML::repositorystate, 1) || {};
    my @files;
    push @files, {
      'name' => 'repositorystate',
      'data' => XMLout($BSXML::repositorystate, $repostate),
    };
    my $fd;
    if (-s "$reporoot/$prp/$arch/:full.solv") {
      my @s = stat(_);
      my $id64 = pack("a64", "$s[9]/$s[7]/$s[1]");
      my $xcachefile = "$reporoot/$prp/$arch/:full.xcache";

      my @modules = @{$cgi->{'module'} || []};
      # can we use the xcache?
      if (!@modules && open($fd, '<', $xcachefile)) {
	my $id;
	if (sysread($fd, $id, 64) == 64 && $id eq $id64) {
          push @files, { 'name' => 'repositorycache', 'filename' => $fd, 'offset' => 64 };
	  BSWatcher::reply_cpio(\@files);
	  return undef;
	}
	unlink($xcachefile);
	close($fd);
	undef $fd;
      }

      my $pool = BSSolv::pool->new();
      my $repo = BSRepServer::addrepo_scan($pool, $prp, $arch);
      if (!$repo) {
        undef $pool;
        BSWatcher::reply_cpio(\@files);
        return undef;
      }

      my @repomodules;	# modules known in this repo
      if (@modules) {
	@repomodules = $repo->getmodules() if defined &BSSolv::pool::getmodules;
	# reduce requested modules to the modules known in this repo
	my %repomodules = map {$_ => 1} @repomodules;
	@modules = grep {$repomodules{$_}} @modules;
      }

      # can we now use the xcache?
      if (!@repomodules && open($fd, '<', $xcachefile)) {
	my $id;
	if (sysread($fd, $id, 64) == 64 && $id eq $id64) {
	  undef $repo;
	  undef $pool;
	  push @files, { 'name' => 'repositorycache', 'filename' => $fd, 'offset' => 64 };
	  BSWatcher::reply_cpio(\@files);
	  return undef;
	}
	unlink($xcachefile);
	close($fd);
	undef $fd;
      }

      $pool->setmodules(\@modules) if @modules && defined &BSSolv::pool::setmodules;
      my %data = $repo->pkgnames();
      for my $p (values %data) {
	$p = $pool->pkg2data($p);
	if ($p->{'annotation'}) {
	  $p->{'annotationdata'} = export_annotation($p->{'annotation'});
	  $p->{'annotation'} = create_legacy_annotation($p->{'annotationdata'});
	}
      }
      # return known modules if some module was requested
      $data{'/modules'} = \@repomodules if @repomodules;
      if (keys(%data) < 100 && $s[7] < 10000) {
	# small repo, feed from memory
	push @files, { 'name' => 'repositorycache', 'data' => BSUtil::tostorable(\%data) };
      } else {
	# cache result
	my $tmpname = "$xcachefile.$$";
	open($fd, '+>', $tmpname) || die("$tmpname: $!\n");
	# Storable uses PerlIO_write, so we have to use print instead of syswrite here
	print $fd $id64;
	Storable::nstore_fd(\%data, $fd) || die("nstore_fd $tmpname: $!\n");
	$fd->flush();
	BSUtil::do_fdatasync(fileno($fd)) if $BSUtil::fdatasync_before_rename;
	if (@repomodules) {
	  unlink($tmpname);
	} else {
	  rename($tmpname, $xcachefile);
	}
	push @files, { 'name' => 'repositorycache', 'filename' => $fd, 'offset' => 64 };
      }
      undef $repo;
      undef $pool;
    } elsif (-s "$reporoot/$prp/$arch/:full.cache") {
      # compatibility code, to be removed...
      if (open($fd, '<', "$reporoot/$prp/$arch/:full.cache")) {
        push @files, { 'name' => 'repositorycache', 'filename' => $fd };
      }
    }
    BSWatcher::reply_cpio(\@files);
    return undef;
  }

  if ($view eq 'cpioheaders') {
    my ($pool, $repo) = BSRepServer::setup_pool_with_repo($prp, $arch, $cgi->{'module'});
    my %names = $repo ? $repo->pkgnames() : ();
    my @bins = $cgi->{'binary'} ? @{$cgi->{'binary'}} : sort keys %names;
    my @files;
    for my $bin (@bins) {
      my $p = $names{$bin};
      if (!$p) {
	push @files, {'name' => $bin, 'error' => 'not available'};
	next;
      }
      my $path = "$reporoot/".$pool->pkg2fullpath($p, $arch);
      if ($path !~ /\.rpm$/) {
	push @files, {'name' => $bin, 'error' => 'not an rpm'};
	next;
      }
      my ($lead, $sighdr, $hdr, $hdrmd5);
      eval {
        ($lead, $sighdr, $hdr, $hdrmd5) = getrpmheaders($path, 1);
      };
      if ($hdr) {
	push @files, {'name' => "$bin-$hdrmd5", 'data' => "$lead$sighdr$hdr"};
      } else {
        my $err = $@;
	chomp $err;
	push @files, {'name' => $bin, 'error' => $err || 'bad rpm'};
      }
    }
    BSWatcher::reply_cpio(\@files);
    return undef;
  }

  if ($view eq 'cpio') {
    my $serial;
    $serial = BSWatcher::serialize("$reporoot/$projid/$repoid/$arch") if $BSStdServer::isajax;
    return if $BSStdServer::isajax && !defined $serial;
    my @files;
    my ($pool, $repo) = BSRepServer::setup_pool_with_repo($prp, $arch, $cgi->{'module'});
    my %names = $repo ? $repo->pkgnames() : ();
    my @bins = $cgi->{'binary'} ? @{$cgi->{'binary'}} : sort keys %names;
    my $dodurl = $repo->dodurl();
    my $needscan;
    for my $bin (@bins) {
      my $p = $names{$bin};
      if (!$p) {
	push @files, {'name' => $bin, 'error' => 'not available'};
	next;
      }
      my $path = "$reporoot/".$pool->pkg2fullpath($p, $arch);
      if ($dodurl && $pool->pkg2pkgid($p) eq 'd0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0') {
	my @handoff = ("/build/$projid/$repoid/$arch/_repository", undef, BSRPC::args($cgi, 'view', 'binary', 'module'));
        $path = BSRepServer::DoD::fetchdodbinary("$reporoot/$prp/$arch", $pool, $repo, $p, \@handoff);
        return unless defined $path;
        $needscan = 1;
      }
      my $n = $bin;
      if ($n =~ /^container:/) {
	$n .= $1 if $path =~ /(\.tar(?:\..+)?)$/;
	if ($1 eq '.tar' && ! -e $path) {
	  my $fd = BSRepServer::Containertar::open_container($path);
	  push @files, {'name' => $n, 'filename' => ($fd || $path)};
	  next;
	}
      } elsif ($path =~ /\.($binsufsre)$/) {
	$n .= ".$1";
      }
      if ($BSStdServer::isajax) {
	push @files, {'name' => $n, 'filename' => $path};
	next;
      }
      my $fd = gensym;
      if (!open($fd, '<', $path)) {
	push @files, {'name' => $bin, 'error' => 'not available'};
      } else {
        push @files, {'name' => $n, 'filename' => $fd};
      }
    }
    undef $repo;
    undef $pool;
    BSWatcher::serialize_end($serial) if defined $serial;
    forwardevent($cgi, 'scanrepo', $projid, undef, $repoid, $arch) if $needscan;
    BSWatcher::reply_cpio(\@files);
    return undef;
  }

  if ($view eq 'binaryversions') {
    return getbinaryversions($cgi, $projid, $repoid, $arch);
  }

  if ($view eq 'availablebinaries') {
    my (%available, %available_pattern, %available_product);
    getavailable($projid, $repoid, $arch, \%available, \%available_pattern, \%available_product);
    my %res;
    $res{'packages'} = processavailable(\%available) if %available;
    $res{'patterns'} = processavailable(\%available_pattern) if %available_pattern;
    $res{'products'} = processavailable(\%available_product) if %available_product;
    return (\%res, $BSXML::availablebinaries);
  }

  die("unsupported view '$view'\n") if $view && $view ne 'names';

  my $serial;
  $serial = BSWatcher::serialize("$reporoot/$projid/$repoid/$arch") if $BSStdServer::isajax;
  return if $BSStdServer::isajax && !defined $serial;
  my ($pool, $repo) = BSRepServer::setup_pool_with_repo($prp, $arch, $cgi->{'module'});
  my %names = $repo ? $repo->pkgnames() : ();
  my @bins = $cgi->{'binary'} ? @{$cgi->{'binary'}} : sort keys %names;
  my @res;
  my $needscan;
  my $dodurl = $repo->dodurl();
  my @handoff = ("/build/$projid/$repoid/$arch/_repository", undef, BSRPC::args($cgi, 'view', 'binary', 'module'));
  for my $bin (@bins) {
    my $p = $names{$bin};
    if (!$p) {
      push @res, {'filename' => $bin, 'size' => 0};
      next;
    }
    my $path = $pool->pkg2path($p);
    my $n = $bin;
    if ($bin =~ /^container:/ && $pool->pkg2bsid($p) eq 'dod') {
      my $r = {'filename' => $view eq 'names' ? $n : (substr($n, 10).'.tar') };
      push @res, $r;
      next;
    }
    if ($bin =~ /^container:/ && $path =~ /(\.tar(?:\..+)?)$/) {
      $n .= $1;
      my $r = {'filename' => $view eq 'names' ? $n : $path };
      my @s = stat("$reporoot/$prp/$arch/:full/$path");
      @s = BSRepServer::Containertar::stat_container("$reporoot/$prp/$arch/:full/$path") if $1 eq '.tar' && !@s;
      ($r->{'mtime'}, $r->{'size'}) = ($s[9], $s[7]) if @s;
      push @res, $r;
      next;
    }
    $n .= ".$1" if $path =~ /\.($binsufsre)$/;
    my $r = {'filename' => $view eq 'names' ? $n : $path };
    my $id = $pool->pkg2bsid($p);
    if ($id && $bin !~ /^container:/) {
      if ($id eq 'dod') {
        $r->{'mtime'} = '';
        $r->{'size'} = '';
	if ($dodurl && $cgi->{'binary'}) {
	  # this is used in the interconnect, so we need to fetch the dod binary
	  $path = BSRepServer::DoD::fetchdodbinary("$reporoot/$prp/$arch", $pool, $repo, $p, \@handoff);
	  return unless defined $path;
          my @s = stat($path);
          ($r->{'mtime'}, $r->{'size'}) = ($s[9], $s[7]) if @s;
          $needscan = 1;
	}
      } else {
        my @s = split('/', $id, 3);
        $r->{'mtime'} = $s[0];
        $r->{'size'} = $s[1];
      }
    } else {
      my @s = stat("$reporoot/$prp/$arch/:full/$path");
      ($r->{'mtime'}, $r->{'size'}) = ($s[9], $s[7]) if @s;
    }
    push @res, $r;
  }
  undef $repo;
  undef $pool;
  BSWatcher::serialize_end($serial) if defined $serial;
  forwardevent($cgi, 'scanrepo', $projid, undef, $repoid, $arch) if $needscan;
  return ({'binary' => \@res}, $BSXML::binarylist);
}

sub filtersources {
  my (@bins) = @_;
  my $debian = grep {/\.(?:dsc|sdeb)$/} @bins;
  for my $bin (splice @bins) {
    next if $bin =~ /\.(?:no)?src\.rpm$/;
    next if $bin =~ /-debug(?:info|source).*\.rpm$/;
    next if $debian && ($bin !~ /\.deb$/) && ($bin !~ /[-.]appdata\.xml$/) && $bin ne '_modulemd.yaml';
    push @bins, $bin;
  }
  return @bins;
}

sub filtersources_bininfo {
  my ($bininfo) = @_;
  return unless $bininfo->{'.nosourceaccess'};
  for my $bin (keys %$bininfo) {
    delete $bininfo->{$bin} if $bin =~ /\.(?:no)?src\.rpm$/;
    delete $bininfo->{$bin} if $bin =~ /-debug(:?info|source).*\.rpm$/;
  }
}

# expand the binary names to a list of files for aggregate building.
# see BSSched::BuildJob::Aggregate::build()
sub getbinarylist_aggregatemode {
  my ($dir, $bins, $binarylist, $nosource) = @_;
  my %binaries = map {$_ => 1}  @$binarylist;
  my $bininfo = BSUtil::retrieve("$dir/.bininfo", 1) || {};
  my @res;
  my @sources;
  my %srcbinaries;
  my %bins = map {$_ => 1} @$bins;
  for my $bin (sort @$bins) {
    next if $bin eq 'logile' || $bin eq 'status' || $bin eq 'reason' || $bin eq 'history' || $bin =~ /^\./;
    if ($bin !~ /^(.*)\.(?:$binsufsre)$/) {
      next if $bin =~ /\.slsa_provenance.json$/;
      push @res, $bin;	# take them all for now
      if ($bin =~ /(.*)\.(?:containerinfo|helminfo)$/) {
        push @res, "$1.slsa_provenance.json" if $bins{"$1.slsa_provenance.json"};
      }
      next;
    }
    my $prefix = $1;
    my @s = stat("$dir/$bin");
    my $r = $bininfo->{$bin};
    $r = undef if $r && ($r->{'id'} || '') ne "$s[9]/$s[7]/$s[1]";
    eval {
      $r ||= Build::query("$dir/$bin", 'evra' => 1);
      BSVerify::verify_nevraquery($r) if $r;
    };
    next if $@ || !$r;
    if (!$r->{'source'}) {
      push @sources, [ $bin, $r, $prefix ] unless $nosource;
      next;
    }
    next unless $binaries{$r->{'name'}};
    push @res, $bin;
    push @res, "$prefix.slsa_provenance.json" if $bins{"$prefix.slsa_provenance.json"};
    $srcbinaries{$r->{'source'}} = 1 unless $nosource;
  }
  for my $d (@sources) {
    my ($bin, $r, $prefix) = @$d;
    next unless $srcbinaries{$r->{'name'}};
    push @res, $bin;
    push @res, "$prefix.slsa_provenance.json" if $bins{"$prefix.slsa_provenance.json"};
  }
  push @res, "_aggregatemode_no_match" unless @res;
  return @res;
}

sub getbinarylist {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  return getbinarylist_repository($cgi, $projid, $repoid, $arch) if $packid eq '_repository';
  my $prp = "$projid/$repoid";
  my $view = $cgi->{'view'} || '';
  if ($view eq 'cpio' && !$BSStdServer::isajax && !$cgi->{'noajax'}) {
    my @args = BSRPC::args($cgi, 'view', 'binary', 'nosource');
    BSHandoff::handoff_part('interconnect_in', "/build/$projid/$repoid/$arch/$packid", undef, @args);
  }
  my %binaries = map {$_ => 1} @{$cgi->{'binary'} || []};
  if ($view eq 'cpio') {
    my @files;
    my $dir = "$reporoot/$prp/$arch/$packid";
    my @bins = ls($dir);
    %binaries = map {$_ => 1} getbinarylist_aggregatemode($dir, \@bins, $cgi->{'binary'}, $cgi->{'nosource'}) if $cgi->{'aggregatemode'} && %binaries;
    if (!$cgi->{'copybuild'}) {
      @bins = grep {$_ ne 'logfile' && $_ ne 'status' && $_ ne 'reason' && $_ ne 'history' && !/^\./} @bins;
      @bins = grep {!/^::import::/} @bins if $cgi->{'noimport'};
      @bins = BSRepServer::Containertar::add_containers(@bins) if grep {/\.containerinfo$/} @bins;
      @bins = filtersources(@bins) if $cgi->{'nosource'} || -e "$dir/.nosourceaccess";
      @bins = grep {$_ ne "_ccache.tar"} @bins unless $cgi->{'withccache'};
    }
    for (sort @bins) {
      next if %binaries && !$binaries{$_};
      next if -d "$dir/$_";
      if (/\.tar$/ && ! -e "$dir/$_") {
	my $n = $_;
	my $fd = BSRepServer::Containertar::open_container("$dir/$n");
	push @files, {'name' => $n, 'filename' => $fd} if $fd;
	next;
      }
      if ($BSStdServer::isajax || @files > 1000) {
	# do not waste file descriptors
	push @files, {'name' => $_, 'filename' => "$dir/$_"};
	next;
      }
      my $fd;
      next unless open($fd, '<', "$dir/$_");
      push @files, {'name' => $_, 'filename' => $fd};
    }
    if ($cgi->{'copybuild'}) {
      for my $g ('meta', 'logfiles.success', 'logfiles.fail') {
        push @files, { 'name' => ".global.$g", 'filename' => "$reporoot/$prp/$arch/:$g/$packid" } if -e "$reporoot/$prp/$arch/:$g/$packid";
      }
    }
    BSWatcher::reply_cpio(\@files);
    return undef;
  }
  if ($view eq 'cpioheaders') {
    my @files;
    my @bins = grep {/\.rpm$/ && !/^\./} ls("$reporoot/$prp/$arch/$packid");
    @bins = grep {!/^::import::/} @bins if $cgi->{'noimport'};
    @bins = filtersources(@bins) if $cgi->{'nosource'} || -e "$reporoot/$prp/$arch/$packid/.nosourceaccess";
    @bins = grep {$_ ne "_ccache.tar"} @bins unless $cgi->{'withccache'};
    for my $bin (sort @bins) {
      next if %binaries && !$binaries{$_};
      my ($lead, $sighdr, $hdr, $hdrmd5);
      eval {
        ($lead, $sighdr, $hdr, $hdrmd5) = getrpmheaders("$reporoot/$prp/$arch/$packid/$bin", 1);
      };
      if ($hdr) {
        push @files, {'name' => "$bin-$hdrmd5", 'data' => "$lead$sighdr$hdr"};
      } else {
        my $err = $@;
        chomp $err;
        push @files, {'name' => $bin, 'error' => $err || 'bad rpm'};
      }
    }
    BSWatcher::reply_cpio(\@files);
    return undef;
  }
  if ($view eq 'cpioheaderchksums') {
    my %chksum;
    local *CS;
    if (open(CS, '<', "$reporoot/$prp/$arch/$packid/.checksums")) {
      while (<CS>) {
	chomp;
	$chksum{$1} = $_ if /^(.{32}) /;
      }
      close CS;
    }
    my @files;
    my @bins = grep {$_ ne 'logfile' && $_ ne 'status' && $_ ne 'reason' && $_ ne 'history' && !/^\./} ls("$reporoot/$prp/$arch/$packid");
    @bins = grep {!/^::import::/} @bins if $cgi->{'noimport'};
    @bins = filtersources(@bins) if $cgi->{'nosource'} || -e "$reporoot/$prp/$arch/$packid/.nosourceaccess";
    @bins = grep {$_ ne "_ccache.tar"} @bins unless $cgi->{'withccache'};
    for my $bin (sort @bins) {
      next if %binaries && !$binaries{$bin};
      if ($bin =~ /\.rpm$/) {
	my @s = stat "$reporoot/$prp/$arch/$packid/$bin";
	die("$reporoot/$prp/$arch/$packid/$bin: $!\n") unless @s;
	my ($lead, $sighdr, $hdr) = getrpmheaders("$reporoot/$prp/$arch/$packid/$bin");
	my $leadsigmd5 = Digest::MD5::md5_hex("$lead$sighdr");
	die("$bin not in checksum file\n") unless $chksum{$leadsigmd5};
	push @files, {'name' => "$bin", 'mtime' => $s[9], 'data' => "$lead$sighdr${hdr}chk:$chksum{$leadsigmd5} size:$s[7]\n"};
	next;
      }
      my $fd = gensym;
      next unless open($fd, '<', "$reporoot/$prp/$arch/$packid/$bin");
      push @files, {'name' => $bin, 'filename' => $fd};
    }
    BSWatcher::reply_cpio(\@files);
    return undef;
  }
  if ($view eq 'binaryversions') {
    my $bininfo = BSRepServer::read_bininfo("$reporoot/$prp/$arch/$packid");
    filtersources_bininfo($bininfo) if $cgi->{'nosource'} || $bininfo->{'.nosourceaccess'};
    my @res;
    for (sort keys %$bininfo) {
      my $bin = $bininfo->{$_};
      next if %binaries && !$binaries{$bin->{'filename'}};
      next if $cgi->{'noimport'} && $bin->{'filename'} =~ /^::import::/;
      my $r = { 'name' => $bin->{'filename'} };
      $r->{'hdrmd5'} = $bin->{'hdrmd5'} if $bin->{'hdrmd5'};
      $r->{'leadsigmd5'} = $bin->{'leadsigmd5'} if $bin->{'leadsigmd5'};
      my $size = (split('/', $bin->{'id'}))[1];
      $r->{'sizek'} = ($size + 512) >> 10;
      push @res, $r;
    }
    return ({ 'binary' => \@res }, $BSXML::binaryversionlist);
  }
  die("unsupported view '$view'\n") if $view;
  my @res;
  my @bins = grep {$_ ne 'logfile' && $_ ne 'status' && $_ ne 'reason' && $_ ne 'history' && !/^\./} ls("$reporoot/$prp/$arch/$packid");
  @bins = grep {!/^::import::/} @bins if $cgi->{'noimport'};
  @bins = BSRepServer::Containertar::add_containers(@bins) if grep {/\.containerinfo$/} @bins;
  @bins = filtersources(@bins) if $cgi->{'nosource'} || -e "$reporoot/$prp/$arch/$packid/.nosourceaccess";
  @bins = grep {$_ ne "_ccache.tar"} @bins unless $cgi->{'withccache'};
  my %md5sums;
  if ($cgi->{'withmd5'}) {
    if (-s "$reporoot/$prp/$arch/$packid/.checksums") {
      my %chksum;
      local *CS;
      if (open(CS, '<', "$reporoot/$prp/$arch/$packid/.checksums")) {
	while (<CS>) {
	  $chksum{$1} = $2 if /^(.{32}) .*md5:(.{32})/;
	}
	close CS;
      }
      if (%chksum) {
	my $bininfo = BSRepServer::read_bininfo("$reporoot/$prp/$arch/$packid");
	for my $fn (sort keys %{$bininfo || []}) {
	  $md5sums{"$fn-".($bininfo->{$fn}->{'id'} || '')} = $chksum{$bininfo->{$fn}->{'leadsigmd5'} || ''};
	}
      }
    }
  }
  for (sort @bins) {
    next if %binaries && !$binaries{$_};
    my @s = stat("$reporoot/$prp/$arch/$packid/$_");
    if (!@s && /\.tar$/) {
      @s = BSRepServer::Containertar::stat_container("$reporoot/$prp/$arch/$packid/$_");
      next unless @s;
      my $r = {'filename' => $_, 'size' => $s[7], 'mtime' => $s[9]};
      $r->{'md5'} = $s[20] if $cgi->{'withmd5'};
      push @res, $r;
      next;
    }
    next unless @s;
    next if -d _;
    my $r = {'filename' => $_, 'size' => $s[7], 'mtime' => $s[9]};
    if ($cgi->{'withmd5'}) {
      $r->{'md5'} = $md5sums{"$_-$s[9]/$s[7]/$s[1]"};
      if (!$r->{'md5'}) {
        my $ctx = Digest::MD5->new;
	local *F;
	if (open(F, '<', "$reporoot/$prp/$arch/$packid/$_")) {
          $ctx->addfile(*F);
	  close F;
	}
        $r->{'md5'} = $ctx->hexdigest();
      }
    }
    push @res, $r;
  }
  return ({'binary' => \@res}, $BSXML::binarylist);
}

sub getbuildhistory {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  my @history = BSFileDB::fdb_getall_reverse("$reporoot/$projid/$repoid/$arch/$packid/history", $historylay, $cgi->{'limit'} || 100);
  @history = reverse @history;
  return ({'entry' => \@history}, $BSXML::buildhist);
}

sub getbuildstats {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  my @bstats = BSFileDB::fdb_getall_reverse("$reporoot/$projid/$repoid/$arch/$packid/.stats", $BSXML::buildstatslay, $cgi->{'limit'} || 100);
  @bstats = reverse @bstats;
  return ({'entry' => \@bstats}, $BSXML::buildstatslist);
}

sub getbuildreason {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;

  my $reason = readxml("$reporoot/$projid/$repoid/$arch/$packid/reason", $BSXML::buildreason, 1) || {};
  $reason ||= {'explain' => 'no reason known'};
  return ($reason, $BSXML::buildreason);
}

sub getbuildstatus {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;

  my $res = {'package' => $packid};
  my $ps = readpackstatus("$projid/$repoid/$arch");
  if ($ps) {
    $ps = {
      'status' => $ps->{'packstatus'}->{$packid},
      'error' => $ps->{'packerror'}->{$packid},
    };
    undef $ps unless $ps->{'status'};
  }
  if ($ps && $ps->{'status'} ne 'failed' && $ps->{'status'} ne 'done' && $ps->{'status'} ne 'scheduled') {
    $res->{'code'} = $ps->{'status'};
    $res->{'details'} = $ps->{'error'} if exists $ps->{'error'};
  } else {
    my $status = readxml("$reporoot/$projid/$repoid/$arch/$packid/status", $BSXML::buildstatus, 1);
    if (!$status->{'code'}) {
      $res->{'code'} = $status->{'status'} || 'unknown';
      $res->{'details'} = $status->{'error'} if $status->{'error'};
    } else {
      $res->{'code'} = $status->{'code'};
      $res->{'details'} = $status->{'details'} if $status->{'details'};
    }
    if ($status->{'job'}) {
      my $jobstatus = readxml("$jobsdir/$arch/$status->{'job'}:status", $BSXML::jobstatus, 1); 
      if ($jobstatus) {
        delete $res->{'details'};
        $res->{'code'} = $jobstatus->{'code'};
        $res->{'details'} = $jobstatus->{'details'} if $jobstatus->{'details'};
	if ($jobstatus->{'code'} eq 'building' && $jobstatus->{'workerid'}) {
	  $res->{'details'} = "building on $jobstatus->{'workerid'}";
	}
      }
    }
  }
  my $schedulerstate = readschedulerstate($projid, $repoid, $arch);
  $res->{'dirty'} = 'true' if ($schedulerstate->{'code'} || '') eq 'scheduling' || -e "$reporoot/$projid/$repoid/$arch/:schedulerstate.dirty";
  return ($res, $BSXML::buildstatus);
}

sub getjobstatus {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;

  my $status = readxml("$reporoot/$projid/$repoid/$arch/$packid/status", $BSXML::buildstatus, 1);
  # not even scheduled
  return ({}, $BSXML::jobstatus) unless $status && $status->{'status'} eq 'scheduled';

  my $jobstatus = readxml("$jobsdir/$arch/$status->{'job'}:status", $BSXML::jobstatus, 1);
  # not yet building
  return ({}, $BSXML::jobstatus) unless $jobstatus;

  # find last successful build
  my $history = BSFileDB::fdb_getlast("$reporoot/$projid/$repoid/$arch/$packid/history", $historylay);
  my $lastduration;
  $lastduration = $history->{'duration'} if $history;
  $jobstatus->{'lastduration'} = $lastduration if $lastduration;

  return ($jobstatus, $BSXML::jobstatus);
}

sub getlogfile {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;

  die("unknown view '$cgi->{'view'}'\n") if $cgi->{'view'} && $cgi->{'view'} ne 'entry';
  if ($cgi->{'handoff'} && !$BSStdServer::isajax) {
    my @args = BSRPC::args($cgi, 'nostream', 'start', 'end', 'view');
    BSHandoff::handoff("/build/$projid/$repoid/$arch/$packid/_log", undef, @args);
  }
  my $status = readxml("$reporoot/$projid/$repoid/$arch/$packid/status", $BSXML::buildstatus, 1);
  my $jobstatus;

  if ($status && $status->{'status'} eq 'scheduled') {
    $jobstatus = readxml("$jobsdir/$arch/$status->{'job'}:status", $BSXML::jobstatus, 1);
  }

  if (!$cgi->{'last'} && !$cgi->{'lastsucceeded'} && $jobstatus && $jobstatus->{'code'} && $jobstatus->{'code'} eq 'building' && $jobstatus->{'uri'}) {
    my @args = BSRPC::args($cgi, 'nostream', 'start', 'end', 'view');
    if (!$BSStdServer::isajax && !$cgi->{'view'}) {
      BSHandoff::handoff("/build/$projid/$repoid/$arch/$packid/_log", undef, @args);
    }
    push @args, "jobid=$jobstatus->{'jobid'}" if $jobstatus->{'jobid'};
    my $param = {
      'uri' => "$jobstatus->{'uri'}/logfile",
      'joinable' => 1,
      'receiver' => \&BSServer::reply_receiver,
    };
    eval {
      BSWatcher::rpc($param, undef, @args);
    };
    return undef unless $@;
    my $err = $@;
    die($err) if $param->{'reply_receiver_called'} || $BSStdServer::isajax;
    $jobstatus = readxml("$jobsdir/$arch/$status->{'job'}:status", $BSXML::jobstatus, 1);
    die($err) if $jobstatus && $jobstatus->{'code'} && $jobstatus->{'code'} eq 'building' && $jobstatus->{'uri'};
    # no longer building, use local logfile
  }
  my $logfile = "$reporoot/$projid/$repoid/$arch/$packid/logfile";
  if ($jobstatus && $jobstatus->{'code'} && ($jobstatus->{'code'} eq 'finished' || $jobstatus->{'code'} eq 'signing')) {
    $logfile = "$jobsdir/$arch/$status->{'job'}:dir/logfile";
  }
  $logfile = "$reporoot/$projid/$repoid/$arch/:logfiles.success/$packid" if $cgi->{'lastsucceeded'};
  my @s = stat($logfile);
  die("404 package '$packid' has no logfile\n") unless @s;
  if ($cgi->{'view'} && $cgi->{'view'} eq 'entry') {
    my $entry = {'name' => '_log', 'size' => $s[7], 'mtime' => $s[9]};
    return ({'entry' => [ $entry ]}, $BSXML::dir);
  }
  my $start = $cgi->{'start'} || 0;
  my $end = $cgi->{'end'};
  $start = $s[7] + $start if $start < 0;
  $start = 0 if $start < 0;
  die("start out of range: $start\n") if $start > $s[7];
  $end = $s[7] if !defined($end) || $end > $s[7];
  $end = $start if defined($end) && $end < $start;
  my $len = $end - $start;
  my $fd = gensym;
  open($fd, '<', $logfile) || die("$logfile: $!\n");
  defined(sysseek($fd, $start, Fcntl::SEEK_SET)) || die("sysseek: $!\n");
  BSWatcher::reply_file($fd, 'Content-Type: text/plain', "Content-Length: $len");
  close $fd unless $BSStdServer::isajax;
  return undef;
}

sub add_provided_by {
  my ($n, $pool, $dep, $keep) = @_;

  for my $p ($pool->whatprovides($dep)) {
    my $rd = $pool->pkg2data($p);
    delete $rd->{$_} for grep {!$keep->{$_}} keys %$rd;
    ($rd->{'project'}, $rd->{'repository'}) = split('/', $pool->pkg2reponame($p), 2);
    push @{$n->{'providedby'}}, $rd;
  }
}

sub getbinary_info {
  my ($cgi, $projid, $repoid, $arch, $bin, $path) = @_;
  if ($path =~ /\.tar$/ && ! -f $path) {
    my @s = BSRepServer::Containertar::stat_container($path);
    if (@s) {
      my $res = {'mtime' => $s[9], 'size' => $s[7], 'filename' => $path};
      $res->{'filename'} =~ s/.*\///;
      $res->{'disturl'} = $s[22]->{'disturl'} if $s[22] && $s[22]->{'disturl'};
      data2utf8xml($res);
      return ($res, $BSXML::fileinfo);
    }
  }
  my @s = stat($path);
  die("404 $bin: $!\n") unless @s;
  my $res = Build::query($path, 'evra' => 1, 'description' => 1, 'weakdeps' => 1, 'disturl' => 1, 'filelist' => $cgi->{'withfilelist'}) || {};
  if (!%$res && $path =~ /\/updateinfo\.xml$/) {
    my $updateinfos = readxml($path, $BSXML::updateinfo, 1);
    if ($updateinfos && @{$updateinfos->{'update'} || []} == 1) {
      my $updateinfo = $updateinfos->{'update'}->[0];
      $res->{'name'} = $updateinfo->{'id'};
      $res->{'version'} = $updateinfo->{'version'};
      $res->{'summary'} = $updateinfo->{'title'};
      $res->{'description'} = $updateinfo->{'description'};
      my $collection = ($updateinfo->{'pkglist'} || {})->{'collection'} || [];
      if (@$collection) {
        # only look at first collection
        for my $package (@{$collection->[0]->{'package'} || []}) {
          my $nevr = $package->{'name'};
          $nevr .= ".$package->{'arch'}" if $package->{'arch'};
          if ($package->{'version'}) {
            $nevr .= " = ";
            $nevr .= "$package->{'epoch'}:" if $package->{'epoch'};
            $nevr .= "$package->{'version'}" if $package->{'version'};
            $nevr .= "-$package->{'release'}" if defined $package->{'release'};
	  }
          push @{$res->{'provides'}}, $nevr;
        }
      }
    }
  }
  delete $res->{'hdrmd5'};
  $res->{'mtime'} = $s[9];
  $res->{'size'} = $s[7];
  $res->{'filename'} = $path;
  $res->{'filename'} =~ s/.*\///;
  if ($cgi->{'view'} && $cgi->{'view'} eq 'fileinfo_ext') {
    my $projpack;
    my $config;
    if (BSServer::have_content()) {
      my $projpackxml = BSServer::read_data(10000000);
      $projpack = BSUtil::fromxml($projpackxml, $BSXML::projpack, 1);
      $config = '';
    }
    if (!$projpack) {
      my @args = ("project=$projid", "repository=$repoid", "arch=$arch");
      push @args, "partition=$BSConfig::partition" if $BSConfig::partition;
      $projpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'withrepos', 'expandedrepos', 'withremotemap', 'nopackages', @args);
    }
    die("404 no such project/repository\n") unless $projpack->{'project'};
    my $proj = $projpack->{'project'}->[0];
    die("404 no such project\n") unless $proj && $proj->{'name'} eq $projid;
    my $repo = $proj->{'repository'}->[0];
    die("404 no such repository\n") unless $repo && $repo->{'name'} eq $repoid;
    my $bconf;
    $config = $proj->{'config'} if defined $config;	# sent with the content
    if ($config) {
      $bconf = Build::read_config($arch, [split("\n", $config)]);
      $bconf->{'binarytype'} ||= 'UNDEFINED';
    } else {
      $bconf = BSRepServer::getconfig($projid, $repoid, $arch);
    }

    my %remotemap = map {$_->{'project'} => $_} @{$projpack->{'remotemap'} || []};
    my @prp = map {"$_->{'project'}/$_->{'repository'}"} @{$repo->{'path'} || []};
    my $pool = BSSolv::pool->new();
    $pool->settype('deb') if $bconf->{'binarytype'} eq 'deb';
    $pool->settype('arch') if $bconf->{'binarytype'} eq 'arch';
    $pool->setmodules($bconf->{'modules'}) if $bconf->{'modules'} && defined &BSSolv::pool::setmodules;
    for my $prp (@prp) {
      my ($rprojid, $rrepoid) = split('/', $prp, 2);
      my $r;
      if ($remotemap{$rprojid}) {
	$r = BSRepServer::Remote::addrepo_remote($pool, $prp, $arch, $remotemap{$rprojid});
      } else {
	$r = BSRepServer::addrepo_scan($pool, $prp, $arch);
      }
      die("repository $prp not available\n") unless $r;
    }
    $pool->createwhatprovides();
    my %keep = map {$_ => 1} qw{name epoch version release arch};
    for my $dep (@{$res->{'provides'} || []}) {
      my $n = {'dep' => $dep};
      for my $p ($pool->whatrequires($dep)) {
	my $rd = $pool->pkg2data($p);
	delete $rd->{$_} for grep {!$keep{$_}} keys %$rd;
	($rd->{'project'}, $rd->{'repository'}) = split('/', $pool->pkg2reponame($p), 2);
	push @{$n->{'requiredby'}}, $rd;
      }
      push @{$res->{'provides_ext'}}, $n;
    }
    for my $dep (@{$res->{'requires'} || []}) {
      my $n = {'dep' => $dep};
      add_provided_by($n, $pool, $dep, \%keep);
      push @{$res->{'requires_ext'}}, $n;
    }
    for my $dep (@{$res->{'recommends'} || []}) {
      my $n = {'dep' => $dep};
      add_provided_by($n, $pool, $dep, \%keep);
      push @{$res->{'recommends_ext'}}, $n;
    }
    for my $dep (@{$res->{'supplements'} || []}) {
      my $n = {'dep' => $dep};
      add_provided_by($n, $pool, $dep, \%keep);
      push @{$res->{'supplements_ext'}}, $n;
    }
  }
  data2utf8xml($res);
  return ($res, $BSXML::fileinfo);
}

sub getbinary_repository {
  my ($cgi, $projid, $repoid, $arch, $bin) = @_;

  if ($bin eq '_buildconfig') {
    my $cfg = BSRPC::rpc("$BSConfig::srcserver/getconfig", undef, "project=$projid", "repository=$repoid");
    return ($cfg, 'Content-Type: text/plain');
  }

  # switch to access-by-name when accessing a DoD container directly
  if ($bin !~ /^container:/ && $bin =~ /(.+)\.tar$/ && -f "$reporoot/$projid/$repoid/$arch/:full/$1.containerinfo") {
    $bin = "container:$1";
  }

  my $serial;
  $serial = BSWatcher::serialize("$reporoot/$projid/$repoid/$arch") if $BSStdServer::isajax;
  return if $BSStdServer::isajax && !defined $serial;
  my $view = $cgi->{'view'} || '';
  my $path = "$reporoot/$projid/$repoid/$arch/:full/$bin";
  my $path_fd;
  my $needscan;
  if (! -f $path) {
    # return by name
    my $prp = "$projid/$repoid";
    my ($pool, $repo) = BSRepServer::setup_pool_with_repo($prp, $arch, $cgi->{'module'});
    my $dodurl = $repo->dodurl();
    my %rnames = $repo ? $repo->pkgnames() : ();
    my $p = $rnames{$bin};
    if (!$p && $dodurl) {
      # check for future dod package path
      if ($bin =~ /^(.*)\.($binsufsre)$/ && $rnames{$1}) {
        $p = $rnames{$1};
        my $suf = $2;
        undef $p unless $pool->pkg2pkgid($p) eq 'd0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0' && $pool->pkg2path($p) =~ /\.\Q$suf\E$/;
      } elsif ($bin =~ /^(.*)\.tar$/ && $rnames{"container:$1"}) {
        $p = $rnames{"container:$1"};
        undef $p unless $pool->pkg2pkgid($p) eq 'd0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0';
      }
    }
    die("404 no such binary '$bin'\n") unless $p;
    $path = "$reporoot/".$pool->pkg2fullpath($p, $arch);
    if ($dodurl && $pool->pkg2pkgid($p) eq 'd0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0') {
      my @handoff = ("/build/$prp/$arch/_repository/$bin", undef, BSRPC::args($cgi, 'view', 'module'));
      $path = BSRepServer::DoD::fetchdodbinary("$reporoot/$prp/$arch", $pool, $repo, $p, \@handoff);
      return unless defined $path;
      $needscan = 1;
    }
    undef $repo;
    undef $pool;
    if (! -f $path) {
      die("404 $bin: $!\n") unless $bin =~ /^container:/ && $path =~ /\.tar$/;
      if ($view ne 'fileinfo' && $view ne 'fileinfo_ext') {
	if (!$BSStdServer::isajax) {
	  # use reply_container to directly send the blobs instead of constructing the complete tar
	  forwardevent($cgi, 'scanrepo', $projid, undef, $repoid, $arch) if $needscan;
          BSRepServer::Containertar::reply_container($path);
	  return undef;
	}
        $path_fd = BSRepServer::Containertar::open_container($path);
      }
    }
  }
  BSWatcher::serialize_end($serial) if defined $serial;
  forwardevent($cgi, 'scanrepo', $projid, undef, $repoid, $arch) if $needscan;
  return getbinary_info($cgi, $projid, $repoid, $arch, $path, $path) if $view eq 'fileinfo' || $view eq 'fileinfo_ext';
  die("unknown view '$view'\n") if $view;
  my $type = 'application/octet-stream';
  $type = 'application/x-rpm' if $path=~ /\.rpm$/;
  $type = 'application/x-debian-package' if $path=~ /\.deb$/;
  BSWatcher::reply_file($path_fd || $path, "Content-Type: $type");
  return undef;
}

sub getbinary {
  my ($cgi, $projid, $repoid, $arch, $packid, $bin) = @_;
  return getbinary_repository($cgi, $projid, $repoid, $arch, $bin) if $packid eq '_repository';
  # small preinstallimage hack, see getpreinstallimageinfos() function
  if ($bin =~ /^_preinstallimage\.([0-9a-f]{32})$/) {
    my $path = "$reporoot/$projid/$repoid/$arch/$packid/.preinstallimage.$1";
    if (-s $path) {
      BSServer::reply_file($path, 'Content-Type: application/octet-stream');
      return undef;
    }
  }
  my $path = "$reporoot/$projid/$repoid/$arch/$packid/$bin";
  if (-e "$reporoot/$projid/$repoid/$arch/$packid/.nosourceaccess") {
    my @bins = ls("$reporoot/$projid/$repoid/$arch/$packid");
    @bins = filtersources(@bins);
    die("404 $bin: No such file or directory\n") unless grep {$_ eq $bin} @bins;
  }
  my $view = $cgi->{'view'} || '';
  if ($path =~ /\.tar$/ && ! -f $path) {
    return getbinary_info($cgi, $projid, $repoid, $arch, $bin, $path) if $view eq 'fileinfo' || $view eq 'fileinfo_ext';
    return undef if BSRepServer::Containertar::reply_container($path);
  }
  die("404 $bin: $!\n") unless -f $path;
  return getbinary_info($cgi, $projid, $repoid, $arch, $bin, $path) if $view eq 'fileinfo' || $view eq 'fileinfo_ext';
  die("unknown view '$view'\n") if $view;
  my $type = 'application/octet-stream';
  $type = 'application/x-rpm' if $path=~ /\.rpm$/;
  $type = 'application/x-debian-package' if $path=~ /\.deb$/;
  BSServer::reply_file($path, "Content-Type: $type");
  return undef;
}

sub missingdodresources {
  my ($cgi, $projid, $repoid, $arch) = @_;
  die("not a DoD repo '$projid/$repoid/$arch'\n") unless -s "$reporoot/$projid/$repoid/$arch/:full/doddata";
  my $id = $arch;
  $id = "$cgi->{'partition'}/$id" if $cgi->{'partition'};
  BSRepServer::DoD::setmissingdodresources("$reporoot/$projid/$repoid/$arch", $id, $cgi->{'resource'});
  return $BSStdServer::return_ok;
}

sub isolder {
  my ($old, $new) = @_;
  return 0 if $old !~ /\.rpm$/;
  return 0 unless -e $old;
  my %qold = Build::Rpm::rpmq($old, qw{VERSION RELEASE EPOCH});
  return 0 unless %qold;
  my %qnew = Build::Rpm::rpmq($new, qw{VERSION RELEASE EPOCH});
  return 0 unless %qnew;
  my $vold = $qold{'VERSION'}->[0];
  $vold .= "-$qold{'RELEASE'}->[0]" if $qold{'RELEASE'};
  $vold = "$qold{'EPOCH'}->[0]:$vold" if $qold{'EPOCH'};
  my $vnew = $qnew{'VERSION'}->[0];
  $vnew .= "-$qnew{'RELEASE'}->[0]" if $qnew{'RELEASE'};
  $vnew = "$qnew{'EPOCH'}->[0]:$vnew" if $qnew{'EPOCH'};
  my $r = Build::Rpm::verscmp($vold, $vnew);
  # print "isolder $vold $vnew: $r\n";
  return $r > 0 ? 1 : 0;
}

sub putbinary {
  my ($cgi, $projid, $repoid, $arch, $bin) = @_;
  die("file name must end in .deb, .rpm, or .cpio\n") unless $bin =~ /\.(?:$binsufsre|cpio)$/;
  mkdir_p($uploaddir);
  my $tdir = "$reporoot/$projid/$repoid/$arch/:full";
  if ($bin =~ /\.cpio$/) {
    my $fdir = "$uploaddir/$$.dir";
    if (-d $fdir) {
      unlink("$fdir/$_") for ls($fdir);
      rmdir($fdir);
    }
    mkdir_p($fdir);
    my $uploaded = BSServer::read_cpio($fdir, 'accept' => '^.+\.(?:$binsufsre|iso|meta)$');
    die("upload error\n") unless $uploaded;
    if ($cgi->{'wipe'}) {
      for (ls($tdir)) {
        unlink("$tdir/$_") || die("unlink $tdir/$_: $!\n");
      }
    }
    my %upfiles = map {$_->{'name'} => 1} @$uploaded;
    mkdir_p($tdir);
    for my $file (@$uploaded) {
      my $fn = $file->{'name'};
      next if $cgi->{'ignoreolder'} && isolder("$tdir/$fn", "$fdir/$fn");
      rename("$fdir/$fn", "$tdir/$fn") || die("rename $fdir/$fn $tdir/$fn: $!\n");
      $fn =~ s/\.(?:$binsufsre|meta)$//;
      unlink("$tdir/$fn.meta") unless $upfiles{"$fn.meta"};
    }
    unlink("$fdir/$_") for ls($fdir);
    rmdir($fdir);
  } else {
    my $fn = "$uploaddir/$$";
    my $tn = "$tdir/$bin";
    die("upload failed\n") unless BSServer::read_file($fn);
    if ($cgi->{'wipe'}) {
      for (ls($tdir)) {
        unlink("$tdir/$_") || die("unlink $tdir/$_: $!\n");
      }
    }
    if ($cgi->{'ignoreolder'} && isolder($tn, $fn)) {
      unlink($fn);
      return $BSStdServer::return_ok;
    }
    mkdir_p($tdir);
    rename($fn, $tn) || die("rename $fn $tn: $!\n");
    if ($tn =~ s/\.(?:$binsufsre)$//) {
      unlink("$tn.meta");
    }
  }
  dirty($projid, $repoid, $arch);
  if (-d "$eventdir/$arch") {
    my $ev = { type => 'scanrepo', 'project' => $projid, 'repository' => $repoid };
    my $evname = "scanrepo:${projid}::$repoid";
    $evname = "scanrepo:::".Digest::MD5::md5_hex($evname) if length($evname) > 200;
    writexml("$eventdir/$arch/.$evname.$$", "$eventdir/$arch/$evname", $ev, $BSXML::event);
    BSUtil::ping("$eventdir/$arch/.ping");
  }
  return $BSStdServer::return_ok;
}

sub delbinary {
  my ($cgi, $projid, $repoid, $arch, $bin) = @_;

  my $tdir = "$reporoot/$projid/$repoid/$arch/:full";
  unlink("$tdir/$bin") || die("404 $projid/$repoid/$arch/$bin: $!\n");
  if ($bin =~ s/\.(?:$binsufsre)$//) {
    unlink("$tdir/$bin.meta");
  }
  dirty($projid, $repoid, $arch);
  if (-d "$eventdir/$arch") {
    my $ev = { type => 'scanrepo', 'project' => $projid, 'repository' => $repoid };
    my $evname = "scanrepo:${projid}::$repoid";
    $evname = "scanrepo:::".Digest::MD5::md5_hex($evname) if length($evname) > 200;
    writexml("$eventdir/$arch/.$evname.$$", "$eventdir/$arch/$evname", $ev, $BSXML::event);
    BSUtil::ping("$eventdir/$arch/.ping");
  }
  return $BSStdServer::return_ok;
}

sub updateworkerdata {
  my ($idlename, $state, $worker) = @_;
  mkdir_p("$workersdir/$state");
  for my $oldstate (qw{building away down dead idle}) {
    next if $state eq $oldstate;
    rename("$workersdir/$oldstate/$idlename", "$workersdir/$state/$idlename") unless $worker;
    unlink("$workersdir/$oldstate/$idlename");
  }
  writexml("$workersdir/$state/.$idlename", "$workersdir/$state/$idlename", $worker, $BSXML::worker) if $worker;
}

sub updateredisjobstatus {
  my ($arch, $job, $info, $details) = @_;
  return unless $BSConfig::redisserver;
  $info ||= readxml("$jobsdir/$arch/$job", $BSXML::buildinfo, 1);
  BSRedisnotify::updatejobstatus("$info->{'project'}/$info->{'repository'}/$info->{'arch'}", $job, $details) if $info;
}

sub workerstate {
  my ($cgi, $harch, $peerport, $state) = @_;
  my $req = $BSServer::request || {};
  my $peerip = $req->{'peerip'};
  my $peerproto = $cgi->{'proto'} || 'http';
  die("cannot get your ip address\n") unless $peerip;
  die("unsupported proto $peerproto\n") unless $peerproto eq 'http' || $peerproto eq 'https';
  my $workerid = defined($cgi->{'workerid'}) ? $cgi->{'workerid'} : "$peerip:$peerport";
  my $workerskel;
  if (BSServer::have_content()) {
    my $workerskelxml = BSServer::read_data(10000000);
    $workerskel = BSUtil::fromxml($workerskelxml, $BSXML::worker);
    for (qw{job arch}) {
      delete $workerskel->{$_};
    }
    $workerskel->{'hardware'}->{'nativeonly'} = undef if $workerskel->{'hardware'} && exists($workerskel->{'hardware'}->{'nativeonly'});
  }
  my $idlename = "$harch:$workerid";
  $idlename =~ s/\//_/g;
  if ($state eq 'building') {
    updateworkerdata($idlename, 'away');
  } elsif ($state eq 'exit') {
    updateworkerdata($idlename, 'down');
  } elsif ($state eq 'idle') {
    if (-e "$workersdir/building/$idlename") {
      # worker must have crashed, discard old job...
      my $worker = readxml("$workersdir/building/$idlename", $BSXML::worker, 1);
      if ($worker && $worker->{'arch'} && $worker->{'job'} && $worker->{'reposerver'}) {
	# masterdispatched, forward to correct repo server
	eval {
	  BSRPC::rpc({
	    'uri' => "$worker->{'reposerver'}/jobs/$worker->{'arch'}/$worker->{'job'}",
	    'request' => 'POST',
	    'timeout' => 10,
	  }, undef, "cmd=idleworker", "workerid=$workerid");
	};
	warn($@) if $@;
      } elsif ($worker && $worker->{'arch'} && $worker->{'job'}) {
	local *F;
        my $js = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$worker->{'arch'}/$worker->{'job'}:status", $BSXML::jobstatus, 1);
	if ($js) {
	  # be extra careful here not to terminate jobs that run on different workers
	  if ($js->{'code'} eq 'building' && (!defined($js->{'workerid'}) || $js->{'workerid'} eq $workerid)) {
	    print "restarting build of job $worker->{'arch'}/$worker->{'job'}\n";
	    updateredisjobstatus($worker->{'arch'}, $worker->{'job'});
	    unlink("$jobsdir/$worker->{'arch'}/$worker->{'job'}:status");
	  }
	  close F;
        }
      }
    }
    my $worker = {
      'hostarch' => $harch,
      'ip' => $peerip,
      'port' => $peerport,
      'uri' => ($peerip =~ /:/ ? "$peerproto://[$peerip]:$peerport" : "$peerproto://$peerip:$peerport"),
      'workerid' => $workerid,
    };
    $worker = { %$workerskel, %$worker } if $workerskel;
    $worker->{'tellnojob'} = $cgi->{'tellnojob'} if $cgi->{'tellnojob'};

    # make sure that we can connect to the client
    if ($BSConfig::checkclientconnectivity || $BSConfig::checkclientconnectivity) {
      my $param = {
	'uri' => ($peerip =~ /:/ ? "http://[$peerip]:$peerport/status" : "http://$peerip:$peerport/status"),
        'async' => 1,
        'timeout' => 1,
	'sender' => sub {},
      };
      eval {
        my $ret = BSRPC::rpc($param);
        close($ret->{'socket'});
      };
      if ($@) {
	warn($@);
        updateworkerdata($idlename, 'down', $worker);
	die("cannot reach you!\n");
      }
    }
    
    if (-d "$workersdir/disable") {
      my @dis = ls("$workersdir/disable");
      for (@dis) {
        next unless $workerid =~ /^$_/;
        print "worker ip $peerip id $workerid is disabled\n";
        updateworkerdata($idlename, 'down', $worker);
        return $BSStdServer::return_ok;
      }
    }
    updateworkerdata($idlename, 'idle', $worker);
  } else {
    die("unknown state: $state\n");
  }
  return $BSStdServer::return_ok;
}

sub workerdispatched {
  my ($cgi, $arch, $job, $jobid) = @_;
  
  my $req = $BSServer::request || {};
  my $peerip = $req->{'peerip'};
  my $peerport = $cgi->{'port'};
  my $peerproto = $cgi->{'proto'} || 'http';
  die("cannot get your ip address\n") unless $peerip;
  die("unsupported proto $peerproto\n") unless $peerproto eq 'http' || $peerproto eq 'https';
  my $uri = $peerip =~ /:/ ? "$peerproto://[$peerip]:$peerport" : "$peerproto://$peerip:$peerport";
  my $jobstatus = {
    'code' => 'building',
    'uri' => $uri,
    'starttime' => time(),
    'hostarch' => $cgi->{'hostarch'},
    'jobid' => $jobid,
  };
  $jobstatus->{'workerid'} = $cgi->{'workerid'} if defined $cgi->{'workerid'};
  die("404 no such job\n") unless -e "$jobsdir/$arch/$job";
  if (!BSUtil::lockcreatexml(\*F, "$jobsdir/$arch/.reposerver.$$", "$jobsdir/$arch/$job:status", $jobstatus, $BSXML::jobstatus)) {
    die("job lock failed\n");
  }
  # make sure this is the correct job
  my $infoxml = readstr("$jobsdir/$arch/$job", 1);
  if (!$infoxml || Digest::MD5::md5_hex($infoxml) ne $jobid) {
    unlink("$jobsdir/$arch/$job:status");
    die("wrong job\n");
  }
  my $details = $jobstatus->{'workerid'} ? ":building on $jobstatus->{'workerid'}" : '';
  my $info = BSUtil::fromxml($infoxml, $BSXML::buildinfo, 1);
  updateredisjobstatus($arch, $job, $info, "building$details");
  close F;
  return $BSStdServer::return_ok;
}

sub getpreinstallimageinfos {
  my ($cgi, $prpas) = @_;
  my @infos;
  my $match = $cgi->{'match'};
  if ($match) {
    if ($match eq 'body') {
      $match = BSServer::read_data(512, 1);
    } else {
      die("match must be 512 byte in hex\n") unless $match =~ /^[0-9a-f]{1024}$/s;
      $match = pack('H*', $match);
    }
    die("bad match\n") unless length($match) == 512;
  }
  my $imagescnt = 0;
  for my $prpa (@$prpas) {
    my $images = BSRepServer::getpreinstallimages($prpa);
    next unless $images;
    $imagescnt += @$images;
    for my $img (@$images) {
      # the "&" below is not a numeric/logic "and", but a bitstring operation
      next if defined($match) && ($img->{'bitstring'} & $match) ne $img->{'bitstring'};
      $img->{'prpa'} = $prpa;
      $img->{'path'} = "$img->{'package'}/_preinstallimage.$img->{'hdrmd5'}";
      next unless -s "$reporoot/$prpa/$img->{'package'}/.preinstallimage.$img->{'hdrmd5'}";
      delete $img->{'bins'};	# currently not needed
      push @infos, $img;
    }
  }
  print "- sending data for ".@infos." of $imagescnt images\n";
  # send answer as perl storable
  my $answer = BSUtil::tostorable(\@infos);
  return ($answer, 'Content-Type: application/octet-stream');
}

sub getobsgendiffdata {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my $dir = "$reporoot/$projid/$repoid/$arch/:repo";
  my @files;
  for my $f (grep {/[^\.].*\.obsgendiff$/} sort(ls($dir))) {
    push @files, {'name' => $f, 'filename' => "$dir/$f"};
  }
  BSWatcher::reply_cpio(\@files);
  return undef;
}

sub dirty {
  my ($projid, $repoid, $arch) = @_;

  die("dirty: need project id\n") unless defined $projid;
  die("dirty: need arch\n") unless defined $arch;
  my @repos;
  if (defined($repoid)) {
    @repos=($repoid);
  } else {
    @repos = ls("$reporoot/$projid");
  }
  for my $r (@repos) {
    BSUtil::touch("$reporoot/$projid/$r/$arch/:schedulerstate.dirty") if -d "$reporoot/$projid/$r/$arch";
  }
}

sub readschedulerstate {
  my ($projid, $repoid, $arch) = @_;
  my $schedulerstate = readstr("$reporoot/$projid/$repoid/$arch/:schedulerstate", 1) || 'unknown';
  if (substr($schedulerstate, 0, 4) eq 'pst0') {
    $schedulerstate = BSUtil::fromstorable($schedulerstate, 1) || { 'code' => 'unknown' };
  } else {
    chomp $schedulerstate;
    my $details;
    ($schedulerstate, $details) = split(' ', $schedulerstate, 2);
    $schedulerstate = { 'code' => ($schedulerstate || 'unknown') };
    $schedulerstate->{'details'} = $details if $details;
  }
  return $schedulerstate;
}

sub getschedulerstate {
  my ($projid, $repoid, $arch) = @_;

  my $schedulerstate = readschedulerstate($projid, $repoid, $arch);
  my $details = $schedulerstate->{'details'};
  $schedulerstate = $schedulerstate->{'code'} || 'unknown';
  if ($schedulerstate eq 'finished' && !$details) {
    return 'finished'     if -e "$eventdir/publish/${projid}::$repoid";
    return 'publishing'   if -e "$eventdir/publish/${projid}::${repoid}::inprogress";
    return 'unpublished'  if (readstr("$reporoot/$projid/$repoid/$arch/:repodone", 1) || '') =~ /^disabled/;
    return 'published';
  }
  return ($schedulerstate, $details);
}

sub workerstatus {
  my ($cgi) = @_;
  my %workerstates = ('idle' => []);
  if (!$cgi->{'daemonsonly'}) {
    for my $workerstate (qw{idle down dead away}) {
      my @w;
      for my $w (ls("$workersdir/$workerstate")) {
        my $worker = readxml("$workersdir/$workerstate/$w", $BSXML::worker, 1);
        next unless $worker;
        my $uri = $worker->{'uri'} || "http://$worker->{'ip'}:$worker->{'port'}";
        push @w, {'hostarch' => $worker->{'hostarch'}, 'uri' => $uri, 'workerid' => $worker->{'workerid'}};
      }
      next unless @w;
      @w = sort {$a->{'workerid'} cmp $b->{'workerid'} || $a->{'uri'} cmp $b->{'uri'} || $a cmp $b} @w;
      if ($workerstate ne 'idle') {
	delete $_->{'uri'} for @w;
      }
      $workerstates{$workerstate} = \@w;
    }
  }
  my @building;
  my @waiting;
  my @blocked;
  my @buildaverage;
  my @a;
  @a = ls($jobsdir) unless $cgi->{'daemonsonly'};
  for my $a (@a) {
    next unless -d "$jobsdir/$a";
    my @d = grep {!/^\./ && !/:(?:dir|new|cross)$/} ls("$jobsdir/$a");
    @d = sort @d;
    my %d = map {$_ => 1} @d;
    for my $d (grep {/:status$/} @d) {
      delete $d{$d};
      $d =~ s/:status$//;
      next unless $d{$d};	# no buildinfo
      my $s = readxml("$jobsdir/$a/$d:status", $BSXML::jobstatus, 1);
      print "bad job, no status: $d\n" unless $s;
      next unless $s;
      my $jn = $d;
      $jn =~ s/-[0-9a-f]{32}$//s;
      my ($projid, $repoid, $packid) = split('::', $jn);
      my $info;
      if (defined($packid)) {
        # get info from job name like in the dispatcher
	$info = {'project' => $projid, 'repository' => $repoid, 'package' => $packid, 'arch' => $a};
      } else {
	$info = readxml("$jobsdir/$a/$d", $BSXML::buildinfo, 1);
      }
      print "bad job, no info: $d\n" unless $info;
      next unless $info;
      if ($s->{'code'} ne 'building') {
        delete $d{$d};
        next;
      }
      push @building, {'workerid' => $s->{'workerid'}, 'uri' => $s->{'uri'}, 'hostarch' => $s->{'hostarch'}, 'project' => $info->{'project'}, 'repository' => $info->{'repository'}, 'package' => $info->{'package'}, 'arch' => $info->{'arch'}, 'starttime' => $s->{'starttime'}};
      delete $d{$d};
    }
    if (!$BSConfig::masterdispatcher || $BSConfig::masterdispatcher eq $BSConfig::reposerver) {
      push @waiting, {'arch' => $a, 'jobs' => scalar(keys %d)};
    }
    my $si = readxml("$infodir/schedulerinfo.$a", $BSXML::schedulerinfo, 1);
    if ($si && defined($si->{'notready'})) {
      push @blocked, {'arch' => $a, 'jobs' => $si->{'notready'}};
    }
    if ($si && defined($si->{'buildavg'})) {
      push @buildaverage, {'arch' => $a, 'buildavg' => $si->{'buildavg'}};
    }
  }
  @building = sort {$a->{'workerid'} cmp $b->{'workerid'} || $a->{'uri'} cmp $b->{'uri'} || $a cmp $b} @building;
  @waiting = sort {$a->{'arch'} cmp $b->{'arch'} || $a cmp $b} @waiting;
  @blocked = sort {$a->{'arch'} cmp $b->{'arch'} || $a cmp $b} @blocked;
  @buildaverage = sort {$a->{'arch'} cmp $b->{'arch'} || $a cmp $b} @buildaverage; 

  my %types = map {$_ => 1} @{$cgi->{'type'} || []};
  # FIXME: must be able to return multiple partitions
  my @partitions;
  my @daemons;
  my @daemonarchs = grep {s/^bs_sched\.(.*)\.lock$/$1/} sort(ls($rundir));
  push @daemonarchs, 'repserver';
  push @daemonarchs, 'dispatcher' if -e "$rundir/bs_dispatch.lock";
  push @daemonarchs, 'publisher' if -e "$rundir/bs_publish.lock";
  push @daemonarchs, 'signer' if -e "$rundir/bs_signer.lock";
  push @daemonarchs, 'warden' if -e "$rundir/bs_warden.lock";
  push @daemonarchs, 'dodup' if -e "$rundir/bs_dodup.lock";
  push @daemonarchs, 'notifyforward' if $BSConfig::notifyforward || $BSConfig::redisserver;
  @daemonarchs = (@{$cgi->{'arch'}}) if $cgi->{'arch'};
  for my $arch (@daemonarchs) {
    local *F;
    my $daemondata = {'state' => 'dead'};
    my $lock;
    my $state = 'running';
    if ($arch eq 'dispatcher') {
      $lock = "$rundir/bs_dispatch.lock";
      $daemondata->{'type'} = 'dispatcher';
    } elsif ($arch eq 'publisher') {
      $lock = "$rundir/bs_publish.lock";
      $daemondata->{'type'} = 'publisher';
    } elsif ($arch eq 'signer') {
      $lock = "$rundir/bs_signer.lock";
      $daemondata->{'type'} = 'signer';
    } elsif ($arch eq 'warden') {
      $lock = "$rundir/bs_warden.lock";
      $daemondata->{'type'} = 'warden';
    } elsif ($arch eq 'dodup') {
      $lock = "$rundir/bs_dodup.lock";
      $daemondata->{'type'} = 'dodup';
    } elsif ($arch eq 'notifyforward') {
      $lock = "$rundir/bs_notifyforward.lock";
      $daemondata->{'type'} = 'notifyforward';
    } elsif ($arch eq 'repserver') {
      my $req = $BSServer::request;
      $daemondata->{'type'} = 'repserver';
      $daemondata->{'starttime'} = $req->{'server'}->{'starttime'} if $req && $req->{'server'};
      if ($req && $req->{'conf'} && $req->{'conf'}->{'handoffpath'}) {
	$lock = "$req->{'conf'}->{'handoffpath'}.lock";
      }
      $daemondata->{'state'} = 'running' unless $lock;
    } else {
      # scheduler
      $lock = "$rundir/bs_sched.$arch.lock";
      $daemondata->{'type'} = 'scheduler';
      $daemondata->{'arch'} = $arch;
      my $si = readxml("$infodir/schedulerinfo.$arch", $BSXML::schedulerinfo, 1);
      $daemondata->{'queue'} = $si->{'queue'} if $si && $si->{'queue'};
      $state = 'booting' if defined($si->{'booting'});
    }
    next if %types && !$types{$daemondata->{'type'}};
    if ($lock && open(F, '<', $lock)) {
      if (!flock(F, LOCK_EX | LOCK_NB)) {
        my @s = stat(F);
        $daemondata->{'state'} = $state;
        $daemondata->{'starttime'} ||= $s[9] if @s;
      }
      close F;
    }
    push @daemons, $daemondata;
  }

  my $partition = {};
  $partition->{'name'} = $BSConfig::partition if $BSConfig::partition;
  $partition->{'daemon'} = \@daemons if @daemons;
  push @partitions, $partition;

  my $ret = {'partition' => \@partitions};
  if (!$cgi->{'daemonsonly'}) {
    $ret->{'clients'} = @building + @{$workerstates{'idle'}};
    $ret->{'building'} = \@building;
    $ret->{'waiting'} = \@waiting;
    $ret->{'blocked'} = \@blocked;
    $ret->{'buildavg'} = \@buildaverage;
    $ret->{$_} = $workerstates{$_} for keys %workerstates;
  }
  return ($ret, $BSXML::workerstatus);
}

sub sendbadhostevent {
  my ($info, $idlename, $job) = @_;
  my $ev = {
    'type' => 'badhost',
    'project' => $info->{'project'},
    'package' => $info->{'package'},
    'repository' => $info->{'repository'},
    'arch' => $info->{'arch'},
    'worker' => $idlename,
  };
  $ev->{'job'} = $job if $job;
  my $evname = "badhost::$info->{'project'}::$info->{'package'}::$info->{'arch'}::$idlename";
  $evname = "badhost:::".Digest::MD5::md5_hex($evname) if length($evname) > 200;
  mkdir_p("$eventdir/dispatch");
  writexml("$eventdir/dispatch/.$evname.$$", "$eventdir/dispatch/$evname", $ev, $BSXML::event);
}

sub receivekiwitree_scan {
  my ($buildinfo) = @_;

  print "receivekiwitree_scan start\n";
  my %res;
  my %prpas;
  for my $dep (@{$buildinfo->{'bdep'} || []}) {
    next unless defined $dep->{'package'};
    my $repoarch = $dep->{'repoarch'} || $buildinfo->{'arch'};
    next if $repoarch eq 'src';
    $prpas{"$dep->{'project'}/$dep->{'repository'}/$repoarch"}->{$dep->{'package'}} = 1;
  }
  for my $prpa (sort keys %prpas) {
    my $gbininfo = BSRepServer::read_gbininfo("$reporoot/$prpa") || {};
    for my $packid (sort keys %{$prpas{$prpa}}) {
      my $bininfo = $gbininfo->{$packid} || BSRepServer::read_bininfo("$reporoot/$prpa/$packid");
      next unless $bininfo;
      filtersources_bininfo($bininfo) if $bininfo->{'.nosourceaccess'};
      for my $bin (values %$bininfo) {
        if ($bin->{'leadsigmd5'}) {
	  $res{$bin->{'leadsigmd5'}} = "$prpa/$packid/$bin->{'filename'}";
        } elsif ($bin->{'md5sum'} && $bin->{'filename'} =~ /slsa_provenance\.json$/) {
	  $res{'slsa:'.$bin->{'md5sum'}} = "$prpa/$packid/$bin->{'filename'}";
	}
      }
    }
  }
  print "receivekiwitree_scan end\n";
  return \%res;
}

sub receivekiwitree {
  my ($info, $js, $dir) = @_;

  print "receivekiwitree start\n";
  local *F;
  open(F, '<', "$dir/.kiwitree") || die("$dir/.kiwitree: $!\n");
  unlink("$dir/.kiwitree");
  my %todo;
  my %done;
  my $leads;
  my @tosign;
  my $nlinked = 0;
  while(1) {
    my $line = <F>;
    last unless defined $line;
    chomp $line;
    die("bad line: '$line'\n") unless $line =~ /^([fdl]) ([^ ]+)(?: ([^ ]+))?$/;
    my ($type, $file, $extra) = ($1, $2, $3);
    $file =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge;
    die("bad file '$file' (contains \\0)\n") if $file =~ /\0/s;
    die("already processed: $file\n") if $done{$file};
    die("bad file '$file'\n") if "/$file/" =~ /\/\.{0,2}\//s;
    if ($file !~ /\//s) {
      die("toplevel files must be directories\n") if $type ne 'd';
      die("illegal toplevel directory\n") if $file =~ /^[_\.]/s;
    }
    if ($file =~ /^(.*)\//s) {
      die("file without directory\n") unless $done{$1} && $done{$1} eq 'd';
    }
    if ($type eq 'd') {
      mkdir("$dir/$file") || die("mkdir $dir/$file: $!\n");
    } elsif ($type eq 'l') {
      $extra =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge;
      die("bad symlink: $extra (contains \\0)\n") if $extra =~ /\0/s;
      die("bad symlink\n") if "/$extra/" =~ /\/\.?\//;
      if ("/$extra/" =~ /^((?:\/\.\.)+)\/(.*?)$/s) {
        my ($head, $tail) = ($1, $2);
	die("bad upref in symlink\n") if "/$tail/" =~ /\/\.\.\//;
	die("bad upref in symlink\n") if ($head =~ y!/!!) > ($file =~ y!/!!);
      } else {
	die("bad upref in symlink\n") if "/$extra/" =~ /\/\.\.\//;
      }
      symlink($extra, "$dir/$file") || die("symlink $extra $dir/$file: $!\n");
    } elsif ($extra) {
      my $found;
      die("extra is not a md5 sum\n") unless $extra =~ /^[0-9a-f]{32}$/s;
      $leads ||= receivekiwitree_scan($info);
      if ($file =~ /\.slsa_provenance\.json$/ && $leads->{"slsa:$extra"}) {
        # we could use hardlinks here but we might run into some filesystem limit
	my ($fd, $ofd, $buf);
	if (open($fd, '<', "$reporoot/$leads->{'slsa:'.$extra}")) {
	  my @s = stat($fd);
	  my $ctx = Digest::MD5->new;
	  if (open($ofd, '>', "$dir/$file")) {
	    while (sysread($fd, $buf, 8192)) {
	      (syswrite($ofd, $buf) || 0) == length($buf) || die("$dir/$file write: $!\n");
	      $ctx->add($buf);
	    }
	    utime($s[9], $s[9], $ofd) if $s[9];
	    close($ofd) || die("$dir/$file close: $!\n");
	  }
	  close($fd);
	  $found = 1 if $ctx->hexdigest() eq $extra;
	}
	unlink("$dir/$file") unless $found;
      } elsif ($leads->{$extra} && link("$reporoot/$leads->{$extra}", "$dir/$file")) {
	# make sure it's really the correct file
	my $leadsigmd5;
	eval { Build::queryhdrmd5("$dir/$file", \$leadsigmd5); };
	if (!$@ && $leadsigmd5 && $leadsigmd5 eq $extra) {
	  $found = 1;
	  $nlinked++;
	}
	unlink("$dir/$file") unless $found;
      }
      $todo{$file} = 1 unless $found;
    } else {
      push @tosign, $file if $file =~ /\.(?:asc|key)$/s;
      $todo{$file} = 1;
    }
    $done{$file} = $type;
  }
  print "receivekiwitree: linked $nlinked files\n";
  if (%todo) {
    print "receivekiwitree: fetching ".(keys %todo)." files\n";
    my $param = {
      'uri' => "$js->{'uri'}/kiwitree",
      'request' => 'POST',
      'formurlencode' => 1,
      'directory' => $dir,
      'timeout' => 600,
      'acceptsubdirs' => 1,
      'accept' => sub {$todo{$_[1]}},
      'cpiopostfile' => sub {alarm(600)},
      'receiver' => \&BSHTTP::cpio_receiver,
    };
    my $res = BSRPC::rpc($param, undef, map {"file=$_"} sort keys %todo);
    die("kiwitree rpc failed\n") unless $res;
    for (@$res) {
      delete $todo{$_->{'name'}};
    }
    my @missing = sort keys %todo;
    die("could not fetch: @missing\n") if @missing;
  }
  return \@tosign;
}

sub notify_jobresult {
  my ($job, $info, $jobstatus, $prpa) = @_;

  # create notification info
  my %ninfo;
  for (qw{project package repository arch rev srcmd5 verifymd5 readytime reason versrel bcnt release}) {
    $ninfo{$_} = $info->{$_} if defined $info->{$_};
  }
  $ninfo{'starttime'} = $jobstatus->{'starttime'};
  $ninfo{'endtime'} = $jobstatus->{'endtime'};
  $ninfo{'workerid'} = $jobstatus->{'workerid'};
  $ninfo{'previouslyfailed'} = 1 if -e "$reporoot/$prpa/:logfiles.fail/$info->{'package'}";
  # calculate buildtype for the job statistics
  my $buildtype;
  $buildtype = $1 if $info->{'file'} =~ /\.(spec|dsc|kiwi|livebuild|productcompose)$/;
  $buildtype ||= Build::recipe2buildtype($info->{'file'}) || 'unknown';
  $buildtype = $info->{'imagetype'} && ($info->{'imagetype'}->[0] || '') eq 'product' ? 'kiwi-product' : 'kiwi-image' if $buildtype eq 'kiwi';
  $ninfo{'buildtype'} = $buildtype;
  print "job statistics: $job $prpa $jobstatus->{'result'} $ninfo{'readytime'}-$ninfo{'starttime'}-$ninfo{'endtime'} $jobstatus->{'workerid'} $buildtype\n";
  if ($jobstatus->{'result'} eq 'unchanged') {
    BSNotify::notify('BUILD_UNCHANGED', \%ninfo);
  } elsif ($jobstatus->{'result'} eq 'succeeded') {
    BSNotify::notify('BUILD_SUCCESS', \%ninfo);
  } else {
    my $lastfail = BSFileDB::fdb_getlast("$reporoot/$prpa/$info->{'package'}/.failhistory", [ 'failcount', @$BSXML::jobhistlay ]) || {};
    $ninfo{'successive_failcount'} = ($lastfail->{'failcount'} || 0);
    BSNotify::notify('BUILD_FAIL', \%ninfo);
  }
}

sub putjob {
  my ($cgi, $arch, $job, $jobid) = @_;

  local *F;
  die("no such job\n") unless -e "$jobsdir/$arch/$job";
  die("job is not building\n") unless -e "$jobsdir/$arch/$job:status";
  my $oldjobstatus = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$arch/$job:status", $BSXML::jobstatus);
  die("different jobid\n") if $oldjobstatus->{'jobid'} ne $jobid;
  die("job is not building\n") if $oldjobstatus->{'code'} ne 'building';
  die("job is building on a different worker: $cgi->{'workerid'} -- $oldjobstatus->{'workerid'}\n") if $cgi->{'workerid'} && $oldjobstatus->{'workerid'} && $cgi->{'workerid'} ne $oldjobstatus->{'workerid'};
  if (defined($BSConfig::putjob_verify_peerip) && $BSConfig::putjob_verify_peerip) {
    my $req = $BSServer::request || {};
    my $peerip = $req->{'peerip'};
    my $uri = $oldjobstatus->{'uri'};
    $uri =~ s/.*\///s;
    $uri =~ s/:[\d]+$//s;
    $uri =~ s/^\[|\]$//g;
    die("job was dispatched to a different peer\n") unless $peerip eq $uri;
  }

  my $infoxml = readstr("$jobsdir/$arch/$job");
  my $infoxmlmd5 = Digest::MD5::md5_hex($infoxml);
  die("job info does not match\n") if $infoxmlmd5 ne $jobid;

  my $info = readxml("$jobsdir/$arch/$job", $BSXML::buildinfo);
  my $projid = $info->{'project'} || $info->{'path'}->[0]->{'project'};
  my $repoid = $info->{'repository'} || $info->{'path'}->[0]->{'repository'};

  my $now = time();

  my $idlename = "$oldjobstatus->{'hostarch'}:$oldjobstatus->{'workerid'}";
  $idlename =~ s/\//_/g;
  if (!($BSConfig::masterdispatcher && $BSConfig::masterdispatcher ne $BSConfig::reposerver)) {
    print "oops, we are not building ($idlename)?\n" unless -e "$workersdir/building/$idlename";
    mkdir_p("$workersdir/down") unless -d "$workersdir/down";
    rename("$workersdir/building/$idlename", "$workersdir/down/$idlename");
  }

  if ($cgi->{'code'} && $cgi->{'code'} eq 'badhost') {
    # turned out that this host couldn't build the job
    # rebuild on some other
    sendbadhostevent($info, $idlename, $job);
    unlink("$jobsdir/$arch/$job:status");
    close(F);
    if (BSServer::have_content()) {
      # fetch logfile and put in in the .logfile.badhost directory
      my $tmp = "$jobsdir/$arch/.putjob.log.$$";
      unlink($tmp);
      my $badhostextract = sub {
        return ".putjob.log.$$" if $_[1] eq 'logfile';
        return undef;
      };
      BSServer::read_cpio("$jobsdir/$arch", 'map' => $badhostextract);
      if (-s $tmp) {
        mkdir_p("$jobsdir/$arch/.logfile.badhost");
        rename($tmp, "$jobsdir/$arch/.logfile.badhost/$job");
      }
      unlink($tmp);
    }
    return $BSStdServer::return_ok;
  }

  # check if worker time is "good enough"
  if ($cgi->{'now'} && ($cgi->{'now'} > $now + 3600 || $cgi->{'now'} < $now - 3600)) {
    sendbadhostevent($info, $idlename);
    updateredisjobstatus($arch, $job, $info);
    unlink("$jobsdir/$arch/$job:status");
    close(F);
    die("time mismatch\n");
  }

  # now release lock and fetch everything
  close F;

  my $dir = "$jobsdir/$arch/$job:dir";
  my $tmpdir = "$jobsdir/$arch/.putjob.$$";
  if (-e $tmpdir) {
    BSUtil::cleandir($tmpdir);
    rmdir($tmpdir);
    unlink($tmpdir);
    die("$tmpdir: can't remove\n") if -e $tmpdir;
  }
  mkdir_p($tmpdir);
  my $uploaded = BSServer::read_cpio($tmpdir);

  # make sure the meta file is well-formed
  if (-f "$tmpdir/meta") {
    local *F;
    eval {
      open (F, '<', "$tmpdir/meta") || die("$tmpdir/meta: $!\n");
      die("empty meta file\n") unless -s F;
      while (<F>) {
	chomp;
	die("bad meta line: $_\n") unless /^[0-9a-f]{32}  .+/s;
      }
    };
    if ($@) {
      my $err = $@;
      updateredisjobstatus($arch, $job, $info);
      unlink("$jobsdir/$arch/$job:status");
      sendbadhostevent($info, $idlename);
      BSUtil::cleandir($tmpdir);
      rmdir($tmpdir);
      die($err);
    }
  }

  # make sure there are no illegal files
  eval {
    for my $file (@$uploaded) {
      my $name = $file->{'name'};
      die("job contains an illegal file\n") if $name =~ /\.obsbinlnk$/s;
      die("job contains an illegal file\n") if $name =~ /\.obsbininfo$/s;
      die("job contains an illegal file\n") if $name =~ /^_blob\./s;
    }
  };
  if ($@) {
    my $err = $@;
    BSUtil::cleandir($tmpdir);
    rmdir($tmpdir);
    die($err);
  }

  my $have_problem;

  my @check_json;
  push @check_json, '_slsa_provenance.json' if -e "$tmpdir/_slsa_provenance.json";

  # normalize containers
  for my $file (@$uploaded) {
    my $containerinfofile = $file->{'name'};
    next unless $containerinfofile =~ /(.*)\.containerinfo$/;
    my $prefix = $1;
    my $container = "$prefix.tar";
    next unless -f "$tmpdir/$container";
    push @check_json, "$prefix.spdx.json" if -e "$tmpdir/$prefix.spdx.json";
    push @check_json, "$prefix.cdx.json" if -e "$tmpdir/$prefix.cdx.json";
    for (grep {$file->{'name'} =~ /^\Q$prefix\E\.[^\.]+\.intoto\.json$/} @$uploaded) {
      push @check_json, $file->{'name'};
    }
    eval {
      # check that the containerinfo is well formed
      BSRepServer::Containerinfo::readcontainerinfo($tmpdir, $containerinfofile);
      # now do the rewrite
      BSRepServer::Containertar::normalize_container($tmpdir, $container, 1, 1, $arch);
    };
    if ($@) {
      # fail job if we could not normalize the container
      BSUtil::appendstr("$tmpdir/logfile", "\ncontainer normalization of $container failed: $@");
      $have_problem = 1;
    }
  }

  # verify the json
  for my $file (@check_json) {
    eval {
      die("too big\n") if (-s "$tmpdir/$file") >= 256 * 1024 * 1024;
      JSON::XS::decode_json(readstr("$tmpdir/$file"));
    };
    if ($@) {
      BSUtil::appendstr("$tmpdir/logfile", "\nproblem with json file $file: $@");
      $have_problem = 1;
    }
  }

  # delete everything but the log if we found a problem
  if ($have_problem) {
    $cgi->{'code'} = 'failed';
    for my $filename (sort(ls($tmpdir))) {
      unlink("$tmpdir/$filename") unless $filename eq 'meta' || $filename eq 'logfile';
    }
  }

  # now get the lock again
  my $jobstatus;
  my $kiwitree_tosign;
  eval {
    $kiwitree_tosign = receivekiwitree($info, $oldjobstatus, $tmpdir) if $cgi->{'kiwitree'};
    die("no such job\n") unless -e "$jobsdir/$arch/$job";
    die("job is not building\n") unless -e "$jobsdir/$arch/$job:status";
    $jobstatus = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$arch/$job:status", $BSXML::jobstatus);
    die("different jobid\n") if $jobstatus->{'jobid'} ne $jobid;
    die("job is not building\n") if $jobstatus->{'code'} ne 'building';
    die("job is building on a different worker\n") if $jobstatus->{'workerid'} ne $oldjobstatus->{'workerid'} || $jobstatus->{'starttime'} ne $oldjobstatus->{'starttime'};
    if (!@$uploaded && -e $dir) {
      # local image building hack
      rmdir($tmpdir);
    } else {
      if (-e $dir) {
        BSUtil::cleandir($dir);
        rmdir($dir);
      }
      rename($tmpdir, $dir) || die("rename $tmpdir $dir: $!\n");
    }
  };
  if ($@) {
    my $err = $@;
    BSUtil::cleandir($tmpdir);
    rmdir($tmpdir);
    die($err);
  }
  $jobstatus->{'code'} = 'finished';
  $jobstatus->{'endtime'} = $now;
  my $code = $cgi->{'code'};
  # compat: calculate code from upload list if not provided
  if (!$code) {
    $code = 'failed';
    # upload is empty for local image building
    $code = 'succeeded' if !@$uploaded;
    # successful builds have uploaded content.
    $code = 'succeeded' if grep {$_->{'name'} ne 'meta' && $_->{'name'} ne 'logfile'} @$uploaded;
  }
  $code = 'failed' if $code ne 'succeeded' && $code ne 'failed' && $code ne 'unchanged' && $code ne 'genbuildreqs';
  $jobstatus->{'result'} = $code;

  notify_jobresult($job, $info, $jobstatus, "$projid/$repoid/$arch");

  # create obsbinlnk file for kiwi docker results
  if (grep {$_->{'name'} =~ /\.containerinfo$/} @$uploaded) {
    for my $file (@$uploaded) {
      my $prefix = $file->{'name'};
      next unless $prefix =~ s/\.containerinfo$//;
      my $obsbinlink = BSRepServer::Containerinfo::containerinfo2obsbinlnk($dir, "$prefix.containerinfo", $info->{'package'});
      next unless $obsbinlink;
      my $filename = "$prefix.obsbinlnk";
      BSUtil::store("$dir/$prefix.obsbinlnk", undef, $obsbinlink);
    }
  }

  # create binary info to speed up the scheduler
  eval { BSRepserver::Bininfo::create_bininfo_file($dir) };
  if ($@) {
    BSUtil::appendstr("$dir/logfile", "\n$@");
    $jobstatus->{'result'} = 'failed';
    for my $filename (sort(ls($dir))) {
      unlink("$dir/$filename") unless $filename eq 'meta' || $filename eq 'logfile';
    }
  }

  # write build stats for dispatcher
  my @l = ($projid, $repoid, $arch, $info->{'package'}, $jobstatus->{'starttime'},  $jobstatus->{'endtime'}, $jobstatus->{'result'}, $jobstatus->{'workerid'}, $jobstatus->{'hostarch'});
  s/([\000-\037%|=\177-\237])/sprintf("%%%02X", ord($1))/ge for @l;
  BSUtil::appendstr("$jobsdir/finished", join('|', @l)."\n");

  my $ev = {'type' => 'built', 'arch' => $arch, 'job' => $job};

  if ($BSConfig::sign && (@{$kiwitree_tosign || []} || grep {$_->{'name'} eq '_slsa_provenance.json' || $_->{'name'} =~ /\.(?:d?rpm|sha256|iso|pkg\.tar\.gz|pkg\.tar\.xz|pkg\.tar\.zst|AppImage|deb|appx|apk|helminfo|raw|efi|roothash|usrhash)$/} @$uploaded)) {
    if (@{$kiwitree_tosign || []}) {
      my $c = '';
      $c .= BSHTTP::urlencode($_)."\n" for @$kiwitree_tosign;
      writestr("$dir/.kiwitree_tosign", undef, $c);
    } else {
      unlink("$dir/.kiwitree_tosign");
    }
    $jobstatus->{'code'} = 'signing';
  } else {
    $jobstatus->{'code'} = 'finished';
  }
  # write jobstatus and free lock
  writexml("$jobsdir/$arch/.$job:status", "$jobsdir/$arch/$job:status", $jobstatus, $BSXML::jobstatus);
  updateredisjobstatus($arch, $job, $info, $jobstatus->{'code'});
  close F;
  dirty($projid, $repoid, $arch) unless $jobstatus->{'code'} eq 'signing';
  # send event to signer or scheduler
  my $evname = "finished:$job";
  if ($jobstatus->{'code'} eq 'signing') {
    $evname = "finished:$arch:$job";
    $evname = "finished:::".Digest::MD5::md5_hex($evname) if length($evname) > 240;
    $ev->{'time'} = time();
    $arch = 'signer';
  }
  mkdir_p("$eventdir/$arch");
  writexml("$eventdir/$arch/.$evname$$", "$eventdir/$arch/$evname", $ev, $BSXML::event);
  BSUtil::ping("$eventdir/$arch/.ping");
  return $BSStdServer::return_ok;
}

sub getjobdata {
  my ($cgi, $arch, $job, $jobid) = @_;
  local *F;
  die("no such job\n") unless -e "$jobsdir/$arch/$job";
  die("job is not building\n") unless -e "$jobsdir/$arch/$job:status";
  my $jobstatus = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$arch/$job:status", $BSXML::jobstatus);
  die("different jobid\n") if $jobstatus->{'jobid'} ne $jobid;
  die("job is not building\n") if $jobstatus->{'code'} ne 'building';
  my $dir = "$jobsdir/$arch/$job:dir";
  die("job has no jobdata\n") unless -d $dir;
  my @send;
  for my $file (grep {!/^\./} ls($dir)) {
    next unless -f "$dir/$file";
    push @send, {'name' => "$file", 'filename' => "$dir/$file"};
  }
  close F;	# XXX: too early?
  BSServer::reply_cpio(\@send);
  return undef;
}

sub moveproject {
  my ($cgi, $projid) = @_;
  my $oprojid = $cgi->{'oproject'};
  return $BSStdServer::return_ok if $oprojid eq $projid;
  return $BSStdServer::return_ok unless -d "$reporoot/$oprojid";

  # FIXME: this is only save when scheduler are stopped. let them doing this ...
  rename("$reporoot/$oprojid", "$reporoot/$projid");

  return $BSStdServer::return_ok;
}

sub copybuild {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  my $oprojid = defined($cgi->{'oproject'}) ? $cgi->{'oproject'} : $projid;
  my $orepoid = defined($cgi->{'orepository'}) ? $cgi->{'orepository'} : $repoid;
  my $opackid = defined($cgi->{'opackage'}) ? $cgi->{'opackage'} : $packid;
  return $BSStdServer::return_ok if $oprojid eq $projid && $orepoid eq $repoid && $opackid eq $packid;
  return $BSStdServer::return_ok unless $cgi->{'remoteurl'} || -d "$reporoot/$oprojid/$orepoid/$arch/$opackid";
  my $job = "copy-".Digest::MD5::md5_hex("$$/$projid/$repoid/$arch/$packid".time());
  local *F;
  my $jobstatus = {
    'code' => 'finished',
  };
  mkdir_p("$jobsdir/$arch") unless -d "$jobsdir/$arch";
  if (!BSUtil::lockcreatexml(\*F, "$jobsdir/$arch/.$job:status", "$jobsdir/$arch/$job:status", $jobstatus, $BSXML::jobstatus)) {
    die("job lock failed\n");
  }
  my $dir = "$jobsdir/$arch/$job:dir";
  my $ogdst = "$reporoot/$oprojid/$orepoid/$arch";
  my $odir = "$ogdst/$opackid";
  mkdir_p($dir);
  if ($cgi->{'remoteurl'}) {
    $odir = "$dir/.remote";
    mkdir_p($odir);
    my $param = {
      'uri' => "$cgi->{'remoteurl'}/build/$oprojid/$orepoid/$arch/$opackid",
      'directory' => $odir,
      'timeout' => 600,
      'receiver' => \&BSHTTP::cpio_receiver,
    };
    BSRPC::rpc($param, undef, 'view=cpio', 'noajax=1', 'copybuild=1');
    rmdir($odir);
    if (!-d $odir) {
      rmdir($dir);
      unlink("$jobsdir/$arch/$job:status");
      close(F);
      return $BSStdServer::return_ok;
    }
  }
  my %delayed_linking;
  my $needsign;
  my %renamed;
  for my $bin (grep {$_ ne 'status' && $_ ne 'reason' && $_ ne 'history' && $_ ne 'meta' && !/^\./} sort(ls($odir))) {
    if ($bin eq "updateinfo.xml" && $cgi->{'setupdateinfoid'}) {
      my $updateinfo = readxml("$odir/$bin", $BSXML::updateinfo);
      for (@{$updateinfo->{'update'} || []}) {
        $_->{'id'} = $cgi->{'setupdateinfoid'};
        $_->{'issued'} = { 'date' => time() } if $_->{'issued'};
      }
      writexml("$dir/$bin", undef, $updateinfo, $BSXML::updateinfo);
    } else {
      next if $bin =~ /^::import::/;	# can't copy those yet
      $needsign = 1 if $bin =~ /\.(?:d?rpm|sha256|iso)$/;
      my $nbin = $bin;
      my $setrelease = $cgi->{'setrelease'};
      my $oldsetrelease;
      $oldsetrelease = readstr("$odir/.setrelease") if -e "$odir/.setrelease";
      # directories are stripped of the build/release number by default
      if (!defined($setrelease)) {
        $setrelease = '' if -d "$odir/$bin";
        # need to keep associated files in sync with dir
        $setrelease = '' if $bin =~ /^(.*)\.(?:report|milestone|cdx\.json|spdx\.json|[^\.]+\.intoto\.json)$/ && -d "$odir/$1";
      }
      if (defined($oldsetrelease) && $oldsetrelease eq '-') {
        # we use '-' as "released without setrelease" marker
        undef $oldsetrelease;
        $oldsetrelease = '' if -d "$odir/$bin";
        # need to keep associated files in sync with dir
        $oldsetrelease = '' if $bin =~ /^(.*)\.(?:report|milestone|cdx\.json|spdx\.json|[^\.]+\.intoto\.json)$/ && -d "$odir/$1";
      }
      if (defined($setrelease) && $setrelease ne '-') {
	$setrelease =~ s/^-?/-/; # "-" will drop the release tag
	$setrelease =~ s/-?$//;  # drop trailing "-", it depends on the format
        # we must ensure to run only one of the following, because people
        # overwrite -BuildX.Y part with -BuildV.W (using not matching numbers)
        # but this must not lead to double matches

	if (defined($oldsetrelease)) {
	  if ($setrelease ne $oldsetrelease) {
            # kiwi product || appliance || product composer
	    if ($oldsetrelease eq '') {
	      if ($nbin !~ s/(-Media\d?(?:\..*?)?)$/$setrelease$1/) {
		# check for productcompose main medium
		if ($bin =~ /^(.*?)(?:\.license|)$/ && (-e "$odir/$1-Source" || -e "$odir/$1-Debug")) {
	          $nbin =~ "$1$setrelease$2";
		} else {
	          $nbin =~ s/(^.*-)/$1$setrelease/;
		}
	      }
	    } else {
              $nbin =~ s/(\Q$oldsetrelease\E)(-Media\d?(?:\..*?)?)$/$setrelease$2/ ||
                 $nbin =~ s/\Q$oldsetrelease\E(\.|-|$)/$setrelease$1/;
	    }
          }
        } else {
          # kiwi product || kiwi appliance || product composer
          $nbin =~ s/-([^-]+)(-Media\d?(?:\..*?)?)$/$setrelease$2/ ||
             $nbin =~ s/-Build[\d.]+(\.|-|$)/$setrelease$1/
        }
	$nbin =~ s/-([^-.]+).([^.]*.rpm)$/$setrelease.$2/; # rpms
        writestr("$dir/.setrelease", undef, defined($cgi->{'setrelease'}) ? $setrelease : "-");
      }
      $renamed{$bin} = $nbin if $bin ne $nbin;
      if (-d "$odir/$bin") {
	if ($cgi->{'remoteurl'}) {
	  rename("$odir/$bin", "$dir/$bin") || die("rename $odir/$bin $dir/$bin: $!\n");
	} else {
	  $delayed_linking{"$dir/$nbin"} = "$odir/$bin";
	}
      } elsif ($bin =~ /\.containerinfo$/) {
	# update file path in containerinfo
	my $containerinfo = readstr("$odir/$bin");
	my $from = $bin;
	my $to = $nbin;
	$from =~ s/\.containerinfo$//;
	$to =~ s/\.containerinfo$//;
	# the hacky way to change json
	$containerinfo =~ s/(\"file\": [^\n]*)\Q$from\E/$1$to/s;
	unlink("$dir/$nbin");
	writestr("$dir/$nbin", undef, $containerinfo);
      } elsif ($bin =~ /\.obsbinlnk$/) {
	my $obsbinlnk = BSUtil::retrieve("$odir/$bin");
	my $from = $bin;
	my $to = $nbin;
	$from =~ s/\.obsbinlnk$//;
	$to =~ s/\.obsbinlnk$//;
	$obsbinlnk->{'path'} =~ s/.*\///;
	$obsbinlnk->{'path'} =~ s/\Q$from\E/$to/;
	$obsbinlnk->{'path'} = "../$packid/$obsbinlnk->{'path'}";
	unlink("$dir/$nbin");
	BSUtil::store("$dir/$nbin", undef, $obsbinlnk);
      } else {
	# patch in new file name if we renamed files
	if (%renamed && $bin =~ /\.sha256$/ && (((-s "$odir/$bin") || 0) <= 65536)) {
	  my $shafile = readstr("$odir/$bin");
	  if ($shafile =~ /-----BEGIN PGP SIGNED MESSAGE-----\n/s) {
	    # de-pgp
	    $shafile =~ s/.*-----BEGIN PGP SIGNED MESSAGE-----//s;
	    $shafile =~ s/.*?\n\n//s;
	    $shafile =~ s/-----BEGIN PGP SIGNATURE-----.*//s;
	  }
          # ensure a possible missing new line
          # kiwi bundler may have forgotten
          $shafile =~ s/\n?$/\n/s if $shafile;
	  my $writeit;
	  for (sort keys %renamed) {
	    $writeit = 1 if $shafile =~ s/([ \/])\Q$_\E\n/$1$renamed{$_}\n/g;
	  }
	  if ($writeit) {
	    unlink("$dir/$nbin");
	    writestr("$dir/$nbin", undef, $shafile);
	    next;
	  }
	}
        link("$odir/$bin", "$dir/$nbin") || die("link $odir/$bin $dir/$nbin: $!\n");
      }
    }
  }
  link("$odir/.meta.success", "$dir/.meta.success") if -e "$odir/.meta.success";
  if ($cgi->{'remoteurl'}) {
    link("$odir/.global.meta", "$dir/meta") if -e "$odir/.global.meta";
    link("$odir/.global.logfiles.success", "$dir/.logfile.success") if -e "$odir/.global.logfiles.success";
    link("$odir/.global.logfiles.fail", "$dir/.logfile.fail") if -e "$odir/.global.logfiles.fail";
  } else {
    link("$ogdst/:meta/$opackid", "$dir/meta") if -e "$ogdst/:meta/$opackid";
    link("$ogdst/:logfiles.success/$opackid", "$dir/.logfile.success");
    link("$ogdst/:logfiles.fail/$opackid", "$dir/.logfile.fail");
  }
  BSUtil::touch("$dir/.preinstallimage") if -e "$odir/.preinstallimage";

  if ($cgi->{'remoteurl'}) {
    BSUtil::cleandir("$dir/.remote");
    rmdir("$dir/.remote") || die("rmdir $dir/.remote: $!\n");
  }

  # we run the linking of directory trees in background, since it can take a long time
  # for simple files it happened already
  if (%delayed_linking) {
    my $pid = xfork();
    if ($pid) {
      # hack: suspend the scheduler until we are done with copying
      my $ev = {'type' => 'suspendproject', 'project' => $projid, 'job' => "copybuild:$job" };
      mkdir_p("$eventdir/$arch");
      writexml("$eventdir/$arch/.suspendproject:$job$$", "$eventdir/$arch/suspendproject:$job", $ev, $BSXML::event);
      return $BSStdServer::return_ok;
    }
    for (sort(keys %delayed_linking)) {
      BSUtil::linktree($delayed_linking{$_}, $_);
    }
  }

  # and emit signals to signer or scheduler
  my $info = {
    'project' => $projid,
    'repository' => $repoid,
    'package' => $packid,
    'arch' => $arch,
    'job' => $job,
    'file' => '_aggregate',	# HACK: makes signer remove old signatures
  };
  writexml("$jobsdir/$arch/.$job", "$jobsdir/$arch/$job", $info, $BSXML::buildinfo);
  my $ev = {'type' => 'uploadbuild', 'arch' => $arch, 'job' => $job};
  if ($BSConfig::sign && $cgi->{'resign'} && $needsign) {
    $jobstatus->{'code'} = 'signing';
    writexml("$jobsdir/$arch/.$job:status", "$jobsdir/$arch/$job:status", $jobstatus, $BSXML::jobstatus);
    $arch = 'signer';
  }
  close F;
  dirty($projid, $repoid, $arch) if $arch ne 'signer';
  mkdir_p("$eventdir/$arch");
  writexml("$eventdir/$arch/.copybuild:$job$$", "$eventdir/$arch/copybuild:$job", $ev, $BSXML::event);
  if (%delayed_linking) {
    # see above
    my $origarch = $info->{'arch'};
    $ev = {'type' => 'resumeproject', 'project' => $projid, 'job' => "copybuild:$job" };
    writexml("$eventdir/$origarch/.resumeproject:$job$$", "$eventdir/$origarch/resumeproject:$job", $ev, $BSXML::event);
  }
  BSUtil::ping("$eventdir/$arch/.ping");
  return $BSStdServer::return_ok;
}

sub uploadbuild {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  my $job = "upload-".Digest::MD5::md5_hex("$$/$projid/$repoid/$arch/$packid".time());
  local *F;
  my $jobstatus = {
    'code' => 'finished',
  };
  mkdir_p("$jobsdir/$arch") unless -d "$jobsdir/$arch";
  if (!BSUtil::lockcreatexml(\*F, "$jobsdir/$arch/.$job:status", "$jobsdir/$arch/$job:status", $jobstatus, $BSXML::jobstatus)) {
    die("job lock failed\n");
  }
  my $dir = "$jobsdir/$arch/$job:dir";
  mkdir_p($dir);
  my $uploaded = BSServer::read_cpio($dir);
  if (!$uploaded || !@$uploaded) {
    rmdir($dir);
    unlink("$jobsdir/$arch/$job:status");
    close F;
    die("upload failed\n");
  }
  unlink("$dir/.bininfo");	# contains inode numbers, better regenerate
  # verify blob checksums
  for my $up (grep {$_->{'name'} =~ /^_blob\./} @$uploaded) {
    my $name = $up->{'name'};
    die("$name: unsupported blob checksum\n") unless $name =~ /^_blob\.sha256:/;
    my $fd;
    open($fd, '<', "$dir/$name") || die("$dir/$name: $!\n");
    my $ctx = Digest::SHA->new(256);
    $ctx->addfile($fd);
    close($fd);
    die("$name: blob checksum error\n") unless $name eq '_blob.sha256:'.$ctx->hexdigest();
  }
  my $info = {
    'project' => $projid,
    'repository' => $repoid,
    'package' => $packid,
    'arch' => $arch,
    'job' => $job,
  };
  writexml("$jobsdir/$arch/.$job", "$jobsdir/$arch/$job", $info, $BSXML::buildinfo);
  
  dirty($projid, $repoid, $arch);
  mkdir_p("$eventdir/$arch");
  my $ev = {'type' => 'uploadbuild', 'job' => $job};
  writexml("$eventdir/$arch/.uploadbuild:$job$$", "$eventdir/$arch/uploadbuild:$job", $ev, $BSXML::event);
  BSUtil::ping("$eventdir/$arch/.ping");
  return $BSStdServer::return_ok;
}

sub forwardevent {
  my ($cgi, $type, $projid, $packid, $repoid, $arch) = @_;
  my $ev = { type => $type };
  $ev->{'project'} = $projid unless $type eq 'configuration';
  my $job;
  my $worker;
  if ($type eq 'badhost') {
    $repoid = $cgi->{'repository'} if exists $cgi->{'repository'};
    $arch = $cgi->{'arch'} if exists $cgi->{'arch'};
    $worker = $cgi->{'worker'} if exists $cgi->{'worker'};
    $job = $cgi->{'job'} if exists $cgi->{'job'};
  }
  $job = $cgi->{'job'} if exists($cgi->{'job'}) && $type eq 'suspendproject' || $type eq 'resumeproject';
  # hack: mis-use job to transfer wipe target
  if ($type eq 'wipe' && $cgi->{'wipe'}) {
    $job = join(',', @{$cgi->{'wipe'}});
  }
  my $evname = "$type:$projid";
  $ev->{'package'} = $packid if defined $packid;
  $evname .= "::$packid" if defined $packid;
  $ev->{'repository'} = $repoid if defined $repoid;
  $evname .= "::$repoid" if defined $repoid;
  $ev->{'arch'} = $arch if defined $arch;
  $evname .= "::$arch" if defined $arch;
  $ev->{'worker'} = $worker if defined $worker;
  $evname .= "::$worker" if defined $worker;
  $ev->{'job'} = $job if defined $job;
  $evname .= "::$job" if defined $job;
  $evname = "${type}:::".Digest::MD5::md5_hex($evname) if length($evname) > 200;
  $arch = 'dispatch' if $type eq 'badhost';
  $arch = 'publish' if $type eq 'publish';
  if ($type eq 'suspendproject' || $type eq 'resumeproject') {
    # those events stack - we must not overwrite them. randomize somewhat.
    $evname = "${type}:::$$-".Digest::MD5::md5_hex("$$/$evname".time());
  }
  if ($arch) {
    mkdir_p("$eventdir/$arch");
    if ($arch ne 'dispatch' && $arch ne 'publish') {
      dirty($projid, $repoid, $arch) if defined($repoid) || $type eq 'project' || $type eq 'package';
    }
    writexml("$eventdir/$arch/.$evname.$$", "$eventdir/$arch/$evname", $ev, $BSXML::event);
    BSUtil::ping("$eventdir/$arch/.ping");
  } else {
    BSConfiguration::check_configuration_once();
    my @archs = @{$BSConfig::schedulerarchs || []};
    if (!$BSConfig::schedulerarchs) {
      # unconfigured, fallback to all existing directories
      for my $a (ls($eventdir)) {
        next if $a =~ /^\./;
        next unless -d "$eventdir/$a" && -e "$infodir/schedulerinfo.$a";
        push @archs, $a;
      }
    }
    for my $a (@archs) {
      eval {
        mkdir_p("$eventdir/$a");
        dirty($projid, $repoid, $a) if defined($repoid) || $type eq 'project' || $type eq 'package';
        writexml("$eventdir/$a/.$evname.$$", "$eventdir/$a/$evname", $ev, $BSXML::event);
        BSUtil::ping("$eventdir/$a/.ping");
      };
      warn($@) if $@;
    }
  }
  return $BSStdServer::return_ok;
}

# done      -> failed|succeeded
# scheduled -> scheduled|dispatching|building|finished|signing  + packerror
# if codefilter is set, packages with a not-matching code will not get fixed
sub fixpackstatus {
  my ($prpa, $ps, $buildingjobs, $codefilter) = @_;
  return unless $ps && $ps->{'packstatus'};
  my $packstatus = $ps->{'packstatus'};
  $buildingjobs ||= {};
  my ($prp, $arch) = $prpa =~ /(.*)\/([^\/]*)$/;
  my $num = keys %$packstatus;
  my $logfiles_fail;
  my $needjob = 1;
  if ($codefilter) {
    $needjob = 0 if $codefilter->{'dontmapscheduled'};
    my %cf = %$codefilter;
    delete $cf{$_} for qw{unresolvable succeeded failed broken disabled excluded blocked locked unknown};
    $needjob = 0 unless %cf;
  }
  for my $packid (keys %$packstatus) {
    $packstatus->{$packid} ||= 'unknown';
    # For old :packstatus files (before 2.0)
    if ($packstatus->{$packid} eq 'expansion error') {
      $packstatus->{$packid} = 'unresolvable';
    } elsif ($packstatus->{$packid} eq 'done') {
      next if $codefilter && !$codefilter->{'failed'} && !$codefilter->{'succeeded'};
      if ($num > 10) {
	$logfiles_fail ||= { map {$_ => 1} ls("$reporoot/$prpa/:logfiles.fail") };
	$packstatus->{$packid} = $logfiles_fail->{$packid} ? 'failed' : 'succeeded';
      } else {
	if (-e "$reporoot/$prpa/:logfiles.fail/$packid") {
	  $packstatus->{$packid} = 'failed';
	} else {
	  $packstatus->{$packid} = 'succeeded';
	}
      }
    } elsif ($packstatus->{$packid} eq 'scheduled') {
      next unless $needjob;
      if (!$buildingjobs->{$arch}) {
	my $ba = {};
        for (grep {s/\:status$//} ls("$jobsdir/$arch")) {
	  if (/^(.*)-[0-9a-f]{32}$/s) {
	    $ba->{$1} = $_;
	  } else {
	    $ba->{$_} = $_;
          }
	}
	$buildingjobs->{$arch} = $ba;
      }
      my $job = jobname($prp, $packid);
      $job = $buildingjobs->{$arch}->{$job};
      if ($job) {
        my $js = readxml("$jobsdir/$arch/$job:status", $BSXML::jobstatus, 1);
	if ($js) {
	  $packstatus->{$packid} = $js->{'code'};
          $ps->{'packerror'}->{$packid} = $js->{'details'} if $js->{'details'};
          $ps->{'packerror'}->{$packid} = "building on $js->{'workerid'}" if $js->{'code'} eq 'building';
	}
      }
    }
  }
}

sub getresult {
  my ($cgi, $prpas) = @_;
  if ($cgi->{'oldstate'} && $BSStdServer::isajax) {
    for my $prpa (@$prpas) {
      BSWatcher::addfilewatcher("$reporoot/$prpa/:packstatus", 120);
    }
  }
  my $r = [];
  my $state = '';
  my %packfilter = map {$_ => 1} @{$cgi->{'package'} || []};
  my %code = map {$_ => 1} @{$cgi->{'code'} || []};
  my %buildingjobs;
  my %lastpublished;
  for my $prpa (@$prpas) {
    my %sum;
    my ($projid, $repoid, $arch) = split('/', $prpa, 3);
    $state .= "$prpa\0\0";
    my $ps = readpackstatus($prpa);
    $ps ||= {'packstatus' => {}, 'packerror' => {}};
    if (%packfilter) {
      for (keys %{$ps->{'packstatus'} || {}}) {
	delete $ps->{'packstatus'}->{$_} unless $packfilter{$_};
      }
      for (keys %packfilter) {
	$ps->{'packststus'}->{$_} ||= 'unknown';
      }
    }
    my ($schedulerstate, $schedulerdetails) = getschedulerstate($projid, $repoid, $arch);
    my $sl = {'project' => $projid, 'repository' => $repoid, 'arch' => $arch, 'code' => $schedulerstate, 'state' => $schedulerstate };
    $sl->{'details'} = $schedulerdetails if defined $schedulerdetails;
    $sl->{'dirty'} = 'true' if -e "$reporoot/$prpa/:schedulerstate.dirty";
    $sl->{'dirty'} = 'true' if $schedulerstate eq 'scheduling'; # flag already removed, but new state not yet written
    if ($ps->{'scmsync'}) {
      $sl->{'scmsync'} = $ps->{'scmsync'};
      $sl->{'scminfo'} = $ps->{'scminfo'} if $ps->{'scminfo'} ;
    }
    $state .= "$schedulerstate\0\0";
    fixpackstatus($prpa, $ps, \%buildingjobs, %code ? \%code : undef) unless $cgi->{'lastbuild'};
    for my $packid (sort(keys %{$ps->{'packstatus'} || {}})) {
      my $code = $ps->{'packstatus'}->{$packid};
      if ($cgi->{'lastbuild'}) {
        if (-e "$reporoot/$prpa/:logfiles.fail/$packid") {
	  $code = 'failed';
        } elsif (-e "$reporoot/$prpa/:logfiles.success/$packid") {
	  $code = 'succeeded';
	} else {
	  $code = 'unknown';
	}
      }
      next if %code && !$code{$code};
      $state .= "$packid\0$code\0";
      if ($cgi->{'summary'}) {
        $sum{$code} = ($sum{$code} || 0) + 1;
      } else {
        my $s = {'package' => $packid, 'code' => $code};
        $s->{'details'} = $ps->{'packerror'}->{$packid} if !$cgi->{'lastbuild'} && $ps->{'packerror'}->{$packid};
        if ($cgi->{'withversrel'} && -e "$reporoot/$prpa/:logfiles.success/$packid") {
	  my $history = BSFileDB::fdb_getlast("$reporoot/$prpa/$packid/history", $historylay) || {};
	  $s->{'versrel'} = $history->{'versrel'} if $history->{'versrel'};
        }
        push @{$sl->{'status'}}, $s;
      }
      if ($cgi->{'withbinarylist'}) {
	my @b;
	my @bins = ls("$reporoot/$prpa/$packid");
	@bins = BSRepServer::Containertar::add_containers(@bins) if grep {/\.containerinfo$/} @bins;
	for (sort(@bins)) {
	  next if $_ eq 'logfile' || $_ eq 'status' || $_ eq 'reason' || $_ eq 'history' || /^\./;
	  my @s = stat("$reporoot/$prpa/$packid/$_");
	  if (!@s && /\.tar$/) {
	    @s = BSRepServer::Containertar::stat_container("$reporoot/$prpa/$packid/$_");
	    push @b, {'filename' => $_, 'mtime' => $s[9], 'size' => $s[7]} if @s;
	    next;
	  }
	  push @b, {'filename' => $_, 'mtime' => $s[9], 'size' => $s[7]} if @s && ! -d _;
	}
	my $bl = {'package' => $packid, 'binary' => \@b};
	push @{$sl->{'binarylist'}}, $bl;
      }
      if ($cgi->{'withinfo'}) {
	my $statistics  = readxml("$reporoot/$prpa/$packid/_statistics", $BSXML::buildstatistics, 1) || {};
	my $info = $statistics->{'info'};
	if ($info) {
	  $info->{'package'} = $packid;
	  push @{$sl->{'info'}}, $info;
	}
      }
    }
    if ($cgi->{'summary'}) {
      my @order = ('succeeded', 'failed', 'unresolvable', 'broken', 'scheduled');
      my %order = map {$_ => 1} @order;
      my @sum = grep {exists $sum{$_}} @order;
      push @sum, grep {!$order{$_}} sort keys %sum;
      $sl->{'summary'} = {'statuscount' => [ map {{'code' => $_, 'count' => $sum{$_}}} @sum ] };
    }
    if ($cgi->{'withstats'}) {
      my $stats = {};
      my @s = stat("$reporoot/$prpa/:packstatus");
      $stats->{'lastchecked'} = $s[9] if @s;
      @s = stat("$reporoot/$prpa/:repoinfo");
      $stats->{'lastfinished'} = $s[9] if @s;	# not really true for image builds...
      my $prp = $prpa;
      $prp =~ s/\/[^\/]+$//;
      if (!exists($lastpublished{$prp})) {
	$lastpublished{$prp} = undef;
        my @s = stat("$reporoot/$prp/:repoinfo");
	my $ri = BSUtil::retrieve("$reporoot/$prp/:repoinfo", 1);
	if ($ri && $ri->{'state'}) {
	  $lastpublished{$prp} = $s[9];
	}
      }
      $stats->{'lastpublished'} = $lastpublished{$prp} if $lastpublished{$prp};
      $sl->{'stats'} = $stats;
    }
    push @$r, $sl;
  }
  $state = Digest::MD5::md5_hex($state);
  if ($cgi->{'oldstate'} && $state eq $cgi->{'oldstate'}) {
    if (!$BSStdServer::isajax) {
      my @args = map {"prpa=$_"} @{$prpas || []};
      push @args, BSRPC::args($cgi, 'oldstate', 'package', 'code', 'withbinarylist');
      BSHandoff::handoff('/_result', undef, @args);
    }
    # return a reply every 5 minutes so that proxies do not time out
    $cgi->{'req_time'} ||= time();
    return undef if time() < $cgi->{'req_time'} + 300;	# watcher will call us back...
  }
  return ({'result' => $r, 'state' => $state}, $BSXML::resultlist);
}

# special call that completely wipes the published area from a prp
sub wipepublishedlocked {
  my ($projid, $repoid) = @_;
  my $prp = "$projid/$repoid";
  return unless -d "$reporoot/$prp";
  local *F;
  BSUtil::lockopen(\*F, '>', "$reporoot/$prp/.finishedlock");
  for my $arch (sort(ls("$reporoot/$prp"))) {
    my $r = "$reporoot/$prp/$arch/:repo";
    next unless -d $r;
    unlink("${r}info");
    BSUtil::cleandir($r);
    rmdir($r);
  }
  close F;
  forwardevent({}, 'publish', $projid, undef, $repoid, undef);
} 

# call that deletes packages from publishing stage and triggers a scanrepo and
# publish event for the prp.
sub unpublish {
  my ($projid, $repoid, $prparchs, $packids) = @_;
  my $prp = "$projid/$repoid";
  my %packids = map {$_ => 1} @{$packids};

  local *F;
  BSUtil::lockopen(\*F, '>', "$reporoot/$prp/.finishedlock");
  for my $arch (@{$prparchs}) {
    my $rpath = "$reporoot/$prp/$arch/:repo";
    next unless -d $rpath;
    if (%packids) {
      # just wipe some packages, need the repoinfo
      my $repoinfo = BSUtil::retrieve("$reporoot/$prp/$arch/:repoinfo");
      my $binaryorigins = $repoinfo->{'binaryorigins'} || {};
      my $dirty;
      for my $bin (sort keys %$binaryorigins) {
        next unless $packids{$binaryorigins->{$bin}};
        if (-d "$rpath/$bin") {
          BSUtil::cleandir("$rpath/$bin");
          rmdir("$rpath/$bin");
        } else {
          unlink("$rpath/$bin");
        }
        delete $binaryorigins->{$bin};
        $dirty = 1;
      }
      BSUtil::store("${rpath}info.new", "${rpath}info", $repoinfo) if $dirty;
    } else {
      # wipe all packages
      unlink("${rpath}info");
      BSUtil::cleandir($rpath);
      rmdir($rpath);
    }
    if (-d "$eventdir/$arch") {
      my $ev = { type => 'recheck', 'project' => $projid, 'repository' => $repoid };
      my $evname = "recheck:${projid}::$repoid";
      $evname = "recheck:::".Digest::MD5::md5_hex($evname) if length($evname) > 200;
      writexml("$eventdir/$arch/.$evname.$$", "$eventdir/$arch/$evname", $ev, $BSXML::event);
      BSUtil::ping("$eventdir/$arch/.ping");
    }
  }
  close F;
  forwardevent({}, 'publish', $projid, undef, $repoid, undef);
}

sub docommand {
  my ($cgi, $cmd, $prpas) = @_;
  my %code = map {$_ => 1} @{$cgi->{'code'} || []};
  my %buildingjobs;
  my %wipepublishedlockeddone;

  if ($cmd eq 'unpublish') {
    die("code filter not supported for unpublish\n") if $cgi->{'code'};
    my %prparchs;
    for my $prpa (@$prpas) {
      my ($projid, $repoid, $arch) = split('/', $prpa);
      push @{$prparchs{"$projid/$repoid"}}, $arch;
    }
    for my $prp (sort keys %prparchs) {
      my ($projid, $repoid) = split('/', $prp);
      unpublish($projid, $repoid, $prparchs{$prp}, $cgi->{'package'} || []);
    }
    return $BSStdServer::return_ok;
  }

  if ($cmd eq 'availablebinaries') {
    my (%available, %available_pattern, %available_product);
    for my $prpa (@$prpas) {
      my ($projid, $repoid, $arch) = split('/', $prpa);
      getavailable($projid, $repoid, $arch, \%available, \%available_pattern, \%available_product);
    }
    my %res;
    $res{'packages'} = processavailable(\%available) if %available;
    $res{'patterns'} = processavailable(\%available_pattern) if %available_pattern;
    $res{'products'} = processavailable(\%available_product) if %available_product;
    return (\%res, $BSXML::availablebinaries);
  }

  for my $prpa (@$prpas) {
    my ($projid, $repoid, $arch) = split('/', $prpa);
    my @packids = @{$cgi->{'package'} || []};
    my $allpacks;
    if (@packids && $packids[0] eq '*') {
      shift @packids;
      $allpacks = 1;
    }
    if (%code) {
      my $ps = readpackstatus($prpa);
      fixpackstatus($prpa, $ps, \%buildingjobs);
      if ($cgi->{'lastbuild'}) {
	for my $packid (splice @packids) {
	  my $code;
	  if (-e "$reporoot/$prpa/:logfiles.fail/$packid") {
	    $code = 'failed';
	  } elsif (-e "$reporoot/$prpa/:logfiles.success/$packid") {
	    $code = 'succeeded';
	  } else {
	    $code = $ps->{'packstatus'}->{$packid} || 'unknown';
	  }
	  push @packids, $packid if $code{$code};
	}
      } else {
        @packids = grep {$code{$ps->{'packstatus'}->{$_} || 'unknown'}} @packids;
      }
    }
    if ($cmd eq 'rebuild') {
      if (@packids) {
	dirty($projid, $repoid, $arch);
	for my $packid (@packids) {
	  unlink("$reporoot/$projid/$repoid/$arch/:meta/$packid");
	  my $ev = { type => 'rebuild', 'project' => $projid, 'package' => $packid };
	  my $evname = "rebuild:${projid}::$packid";
	  $evname = "rebuild:::".Digest::MD5::md5_hex($evname) if length($evname) > 200;
	  if (-d "$eventdir/$arch") {
	    writexml("$eventdir/$arch/.$evname.$$", "$eventdir/$arch/$evname", $ev, $BSXML::event);
	  }
	}
	BSUtil::ping("$eventdir/$arch/.ping") if -d "$eventdir/$arch";
      }
    } elsif ($cmd eq 'sendsysrq') {
      for my $packid (@packids) {
	eval {
	  sendsysrqtobuild($cgi, $projid, $repoid, $arch, $packid);
	};
	warn("$@") if $@;
      }
    } elsif ($cmd eq 'killbuild' || $cmd eq 'abortbuild') {
      for my $packid (@packids) {
	eval {
	  abortbuild($cgi, $projid, $repoid, $arch, $packid);
	};
	warn("$@") if $@;
      }
    } elsif ($cmd eq 'restartbuild') {
      for my $packid (@packids) {
	eval {
	  restartbuild($cgi, $projid, $repoid, $arch, $packid);
	};
	warn("$@") if $@;
      }
    } elsif ($cmd eq 'wipepublishedlocked') {
      my $prp = "$projid/$repoid";
      wipepublishedlocked($projid, $repoid) unless $wipepublishedlockeddone{$prp};
      $wipepublishedlockeddone{$prp} = 1;
    } elsif ($cmd eq 'wipe' || $cmd eq 'wipeallarch') {
      $cmd = 'wipeallarch' if $cgi->{'allarch'};
      undef $allpacks;
      if ($allpacks) {
        forwardevent($cgi, $cmd, $projid, undef, $repoid, $arch);
      } else {
        for my $packid (@packids) {
	  forwardevent($cgi, $cmd, $projid, $packid, $repoid, $arch);
        }
      }
    } elsif ($cmd eq 'force_publish') {
      forwardevent($cgi, 'force_publish', $projid, undef, $repoid, $arch);
    }
  }
  return $BSStdServer::return_ok;
}

# special lastfailures mode: return the last success and the first failure
# after the success if there was a failure. If the package never succeeded,
# return the first failure.
sub getlastfailures {
  my ($cgi, $projid, $repoid, $arch) = @_;

  my $prpa = "$projid/$repoid/$arch";
  # update our little database
  my $db;
  $db = BSUtil::retrieve("$reporoot/$prpa/:lastfailures", 1) || {};
  my $changed;
  local *F;
  return ({jobhist => []}, $BSXML::jobhistlist) unless open(F, '<', "$reporoot/$prpa/:jobhistory");
  if ($db->{'offset'} && $db->{'lastline'} && seek(F, $db->{'offset'}, 0)) {
    if (Digest::MD5::md5_hex(<F> || '') ne $db->{'lastline'}) {
      seek(F, 0, 0) || die("could not rewind\n");
      $db = {};
    }
  } else {
    $db = {};
  }
  $db->{'failure'} ||= {};
  $db->{'success'} ||= {};
  my $failure = $db->{'failure'};
  my $success = $db->{'success'};
  my $ll;
  my $llo;
  while (<F>) {
    next if chop($_) ne "\n";
    $ll = $_;
    $llo = tell(F) - length($_) - 1;
    my $r = BSFileDB::decode_line($_, $BSXML::jobhistlay);
    my $n = $r->{'package'};
    if ($r->{'code'} eq 'succeeded' || $r->{'code'} eq 'unchanged') {
      $success->{$n} = $r;
      delete $failure->{$n};
    } elsif (!$failure->{$n}) {
      $failure->{$n} = $r;
    }
  }
  if (defined($ll)) {
    $db->{'lastline'} = Digest::MD5::md5_hex("$ll\n");
    $db->{'offset'} = $llo;
    BSUtil::store("$reporoot/$prpa/.:lastfailures$$", "$reporoot/$prpa/:lastfailures", $db);
  }
  my %packid = map {$_ => 1} @{$cgi->{'package'}};
  %packid = %{ { %$failure, %$success} } unless %packid;
  my @hist;
  for my $packid (sort keys %packid) {
    push @hist, $success->{$packid} if $success->{$packid};
    push @hist, $failure->{$packid} if $failure->{$packid};
  }
  my $ret = {jobhist => \@hist};
  return ($ret, $BSXML::jobhistlist);
}

sub getlastfailures_old {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my $filter;
 # report last success/unchanged and all fails for each package
  my %success;
  if ($cgi->{'package'}) {
    my %packid = map {$_ => 1} @{$cgi->{'package'}};
    $filter = sub {
      return 0 unless $packid{$_[0]->{'package'}};
      return 1 unless $_[0]->{'code'} eq 'succeeded' || $_[0]->{'code'} eq 'unchanged';
      delete $packid{$_[0]->{'package'}};
      return %packid ? 1 : -1;
    };
  } else {
    $filter = sub {
      return 0 if $success{$_[0]->{'package'}};
      $success{$_[0]->{'package'}} = 1 if $_[0]->{'code'} eq 'succeeded' || $_[0]->{'code'} eq 'unchanged';
      return 1;
    };
  }
  my @hist = BSFileDB::fdb_getall_reverse("$reporoot/$projid/$repoid/$arch/:jobhistory", $BSXML::jobhistlay, undef, $filter);
  @hist = reverse @hist;
  my $ret = {jobhist => \@hist};
  return ($ret, $BSXML::jobhistlist);
}

sub getjobhistory {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my $filter;
  if ($cgi->{'code'} && @{$cgi->{'code'}} == 1 && $cgi->{'code'}->[0] eq 'lastfailures') {
    return getlastfailures($cgi, $projid, $repoid, $arch);
  }
  my $idx = 0;
  my %indices = map {$_ => $idx++} @$BSXML::jobhistlay;
  my $packidx = $indices{'package'};
  my $codeidx = $indices{'code'};
  my $endtimeidx = $indices{'endtime'};
  if ($cgi->{'package'} && $cgi->{'code'}) {
    my %packid = map {BSFileDB::encode_field($_) => 1} @{$cgi->{'package'}};
    my %code = map {$_ => 1} @{$cgi->{'code'}};
    $filter = sub {$packid{$_[$packidx]} && $code{$_[$codeidx]}};
  } elsif ($cgi->{'package'}) {
    my %packid = map {BSFileDB::encode_field($_) => 1} @{$cgi->{'package'}};
    $filter = sub {$packid{$_[$packidx]}};
  } elsif ($cgi->{'code'}) {
    my %code = map {$_ => 1} @{$cgi->{'code'}};
    $filter = sub {$code{$_[$codeidx]}};
  }
  if ($cgi->{'endtime_start'} || $cgi->{'endtime_end'}) {
    my $filter2 = $filter;
    my $endtime_start = $cgi->{'endtime_start'} || 0;
    my $endtime_end = $cgi->{'endtime_end'};
    $filter = sub { $_[$endtimeidx] < $endtime_start ? -2 : defined($endtime_end) && $_[$endtimeidx] > $endtime_end ? 0 : $filter2 ? $filter2->(@_) : 1 };
  }
  my @hist = BSFileDB::fdb_getall_reverse("$reporoot/$projid/$repoid/$arch/:jobhistory", undef, $cgi->{'limit'} || 100, $filter);
  @hist = map {BSFileDB::decode_line($_, $BSXML::jobhistlay)} @hist;
  @hist = reverse @hist;
  my $ret = {jobhist => \@hist};
  return ($ret, $BSXML::jobhistlist);
}

sub getjobhistory_project {
  my ($cgi, $prpas) = @_;
  my @hist;
  for my $prpa (@$prpas) {
    my ($projid, $repoid, $arch) = split('/', $prpa, 3);
    my ($r) = getjobhistory($cgi, $projid, $repoid, $arch);
    ($_->{'repository'}, $_->{'arch'}) = ($repoid, $arch) for @{$r->{'jobhist'} || []};
    push @hist, @{$r->{'jobhist'} || []};
  }
  @hist = sort {$a->{'endtime'} <=> $b->{'endtime'}} @hist;
  splice(@hist, 0, -$cgi->{'limit'}) if $cgi->{'limit'} && @hist > $cgi->{'limit'};
  my $ret = {jobhist => \@hist};
  return ($ret, $BSXML::jobhistlist);
}

$Build::Kiwi::urlmapper = \&BSUrlmapper::urlmapper;

sub getbuildinfo {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  my $binfo = BSRepServer::BuildInfo::buildinfo($projid, $repoid, $arch, $packid,
	  internal => $cgi->{'internal'},
	  add      => $cgi->{'add'},
	  debug    => $cgi->{'debug'},
	);
  return ($binfo, $BSXML::buildinfo);
}

sub getbuildinfo_post_common {
  my ($cgi, $projid, $repoid, $arch, $packid, $fn, $buildtype, $files) = @_;

  my $bconf = BSRepServer::getconfig($projid, $repoid, $arch);
  if (defined($packid) && $packid =~ /(?<!^_product)(?<!^_patchinfo):./) {
    $packid =~ /^(.*):(.*?)$/;
    $packid = $1;
    $bconf->{'buildflavor'} = $2;
  }
  undef $packid if $packid && $packid eq '_repository';
  $bconf->{'obspackage'} = $packid if defined $packid;
  $bconf->{'type'} = $buildtype if $buildtype;

  $files ||= {};
  my $info = eval { BSRepServer::BuildInfo::parse_recipe($bconf, $fn, $files) };
  die $@ if $@;
  $info->{'repository'} = $repoid;

  my $pdata = {'buildtype' => $bconf->{'type'}, 'info' => [ $info ]};
  $pdata->{'buildenv'} = readxml($files->{'buildenv'}, $BSXML::buildinfo) if $files->{'buildenv'};
  $pdata->{'ldepfile'} = $files->{'deps'} if $files->{'deps'};

  my $binfo = BSRepServer::BuildInfo::buildinfo($projid, $repoid, $arch, $packid,
	  pdata	   => $pdata,
	  internal => $cgi->{'internal'},
	  add      => $cgi->{'add'},
	  debug    => $cgi->{'debug'},
	);
  return ($binfo, $BSXML::buildinfo);
}

sub getbuildinfo_post_cpio {
  my ($cgi, $projid, $repoid, $arch, $packid, $cpiofn) = @_;

  local *F;
  open(F, '<', $cpiofn) || die("$cpiofn: $!\n");
  unlink($cpiofn);
  my $dir = "$uploaddir/$$.dir";
  mkdir_p($dir);
  my $uploaded = BSHTTP::cpio_receiver(BSHTTP::fd2req(\*F), {'directory' => $dir});
  close(F);
  my %files = map {$_->{'name'} => "$dir/$_->{'name'}"} @$uploaded;
  # should we check if the cpio archive contains <= 2 files?
  my $fn = (grep { $_->{'name'} ne 'deps' && $_->{'name'} ne 'buildenv' && $_->{'name'} ne '_service'} @$uploaded)[0];
  die("no build recipe file found\n") unless $fn;
  my $buildtype = Build::recipe2buildtype($fn->{'name'});
  my @r = eval { getbuildinfo_post_common($cgi, $projid, $repoid, $arch, $packid, "$dir/$fn->{'name'}", $buildtype, \%files) };
  # cleanup
  unlink("$dir/$_") for ls($dir);
  rmdir($dir) if -d $dir;
  die("$@\n") if $@;
  return @r;
}

sub getbuildinfo_post {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;

  mkdir_p($uploaddir);
  my $fn = "$uploaddir/$$";
  die("upload failed\n") unless BSServer::read_file($fn);

  # check if the upload is a cpio archive by looking at the first 6 bytes
  local *F;
  open(F, '<', $fn) || die("$fn: $!\n");
  my $magic;
  sysread(F, $magic, 6);
  close(F);
  return getbuildinfo_post_cpio($cgi, $projid, $repoid, $arch, $packid, $fn) if $magic eq '070701';

  # it's a simple recipe file 
  my @r = eval { getbuildinfo_post_common($cgi, $projid, $repoid, $arch, $packid, $fn) };
  unlink($fn);
  die("$@\n") if $@;
  return @r;
}

sub getbuilddepinfo {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my $builddepinfo_in;
  if (BSServer::have_content()) {
    my $content = BSServer::read_data(10000000);
    $builddepinfo_in = BSUtil::fromxml($content, $BSXML::builddepinfo);
  }
  my %packids = map {$_ => 1} @{$cgi->{'package'} || []};
  my $view = $cgi->{'view'} || '';
  my $depends = BSUtil::retrieve("$reporoot/$projid/$repoid/$arch/:depends", 1) || {};
  my $subpacks = $depends->{'subpacks'} || {};
  my $pkgdeps = $depends->{'pkgdeps'} || {};
  my $pkg2src = $depends->{'pkg2src'} || {};
  if ($builddepinfo_in) {
    for my $in (@{$builddepinfo_in->{'package'} || []}) {
      my $packid = $in->{'name'};
      next unless $packid;
      $pkg2src->{$packid} = $in->{'source'} if $in->{'source'};
      $subpacks->{$packid} = $in->{'subpkg'} if $in->{'subpkg'};
      delete $pkgdeps->{$packid};
      $pkgdeps->{$packid} = $in->{'pkgdep'} if $in->{'pkgdep'};
    }
  }
  my %subpack2pack;
  if ($view eq 'order') {
    # order like the scheduler does
    my @cycles;
    my @packs = sort keys %$pkg2src;
    @packs = sort keys %packids if %packids;
    @packs = BSSolv::depsort($pkgdeps, $pkg2src, \@cycles, @packs) if @packs > 1;
    my @res = map { { 'name' => $_ } } @packs;
    my $res = { 'package' => \@res, };
    $res->{'cycle'} = [map {{'package' => $_}} @cycles] if @cycles;
    return ($res, $BSXML::builddepinfo);
  }
  if ($view eq 'pkgnames' || $view eq 'revpkgnames') {
    for my $packid (sort keys %$pkg2src) {
      my $n = $pkg2src->{$packid} || $packid;
      if ($subpacks->{$n} && @{$subpacks->{$n}}) {
        push @{$subpack2pack{$_}}, $packid for @{$subpacks->{$n}};
      } else {
        push @{$subpack2pack{$n}}, $packid;
      }
    }
    if ($view eq 'revpkgnames') {
      my %rdeps;
      for my $packid (sort keys %$pkg2src) {
	my $deps = $pkgdeps->{$packid} || []; 
	$deps = [ map {@{$subpack2pack{$_} || []}} @$deps ];
	for (@$deps) {
	  push @{$rdeps{$_}}, $packid;
	}
      }
      $pkgdeps = \%rdeps;
    }
  }
  my @res;
  for my $packid (sort keys %$pkg2src) {
    next if %packids && !$packids{$packid};
    my $n = $pkg2src->{$packid};
    my @sp = sort @{$subpacks->{$n} || []};
    push @sp, $n unless @sp;
    if ($n ne $sp[0] && (grep {$_ eq $n} @sp)) {
      @sp = grep {$_ ne $n} @sp;
      unshift @sp, $n;
    }
    my $deps = $pkgdeps->{$packid} || [];
    $deps = [ map {@{$subpack2pack{$_} || []}} @$deps ] if $view eq 'pkgnames';
    $deps = [ sort(BSUtil::unify(@$deps)) ] if $view eq 'pkgnames' || $view eq 'revpkgnames';
    push @res, {'name' => $packid, 
	'source' => $n,
	'pkgdep' => $deps,
	'subpkg' => \@sp,
    };
  }
  my @cycles = map {{'package' => $_}} @{$depends->{'cycles'} || []};
  my $res = { 'package' => \@res, };
  $res->{'cycle'} = \@cycles if @cycles;
  if (@{$depends->{'sccs'} || []}) {
    my @sccs = @{$depends->{'sccs'} || []};
    @$_ = sort @$_ for @sccs;
    @sccs = sort {$a->[0] cmp $b->[0]} @sccs;
    $res->{'scc'} = [ map {{'package' => $_}} @sccs ];
  }
  return ($res, $BSXML::builddepinfo);
}

### FIXME: read status instead!
sub findjob {
  my ($projid, $repoid, $arch, $packid) = @_;

  my $prp = "$projid/$repoid";
  my $job = jobname($prp, $packid);
  my @jobdatadirs = grep {$_ eq "$job:status" || /^\Q$job\E-[0-9a-f]{32}:status$/} ls("$jobsdir/$arch");
  return undef unless @jobdatadirs;
  $job = $jobdatadirs[0];
  $job =~ s/:status$//;
  return $job;
}

sub restartbuild {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;

  my $job = findjob($projid, $repoid, $arch, $packid);
  die("not building\n") unless $job;

  local *F;
  my $js = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$arch/$job:status", $BSXML::jobstatus);
  die("not building\n") if $js->{'code'} ne 'building';
  my $req = {
    'uri' => "$js->{'uri'}/discard",
    'timeout' => 30,
  };
  eval {
    BSRPC::rpc($req, undef, "jobid=$js->{'jobid'}");
  };
  warn($@) if $@;
  updateredisjobstatus($arch, $job);
  unlink("$jobsdir/$arch/$job:status");
  close F;
  return $BSStdServer::return_ok;
}

sub abortbuild {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;

  my $job = findjob($projid, $repoid, $arch, $packid);
  die("not building\n") unless $job;
  local *F;
  my $js = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$arch/$job:status", $BSXML::jobstatus);
  die("not building\n") if $js->{'code'} ne 'building';
  my $req = {
    'uri' => "$js->{'uri'}/kill",
    'timeout' => 30,
  };
  BSRPC::rpc($req, undef, "jobid=$js->{'jobid'}");
  return $BSStdServer::return_ok;
}

sub sendsysrqtobuild {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;

  my $job = findjob($projid, $repoid, $arch, $packid);
  die("not building\n") unless $job;
  local *F;
  my $js = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$arch/$job:status", $BSXML::jobstatus);
  die("not building\n") if $js->{'code'} ne 'building';
  my $req = {
    'uri' => "$js->{'uri'}/sysrq",
    'timeout' => 30,
  };
  die("Unsupported sysrq\n") unless $cgi->{'sysrq'} =~ /^[0123456789clptwz ]$/;
  BSRPC::rpc($req, undef, "jobid=$js->{'jobid'}", "sysrq=$cgi->{'sysrq'}");
  return $BSStdServer::return_ok;
}

#
# OBSOLETE: qemu shall be installed into the target system
#           FIXME3.0: remove this
# if there is a qemu dir in OBS backend install dir workers load qemu from OBS backend server
# this is similiar to the rest of build script code
# if that does also not exist, workers copy qemu from worker local installed qemu
#
sub getqemuinterpreters {
  my @send;
  for my $file (grep {!/^\./} ls('qemu')) {
    next unless -f "qemu/$file";
    push @send, {'name' => $file, 'filename' => "qemu/$file"};
  }
  return @send;
}

sub getcode {
  my ($cgi, $dir) = @_;
  my @send;
  push @send, getqemuinterpreters() if $dir eq 'build';
  for my $file (grep {!/^\./} ls($dir)) {
    if (($file eq 'Build' || $file eq 'emulator') && -d "$dir/$file") {
      push @send, {'name' => $file, 'mode' => 0x41ed, 'data' => ''};
      for my $file2 (grep {!/^\./} ls("$dir/$file")) {
	push @send, {'name' => "$file/$file2", 'filename' => "$dir/$file/$file2"};
      }
    }
    next unless -f "$dir/$file";
    push @send, {'name' => "$file", 'filename' => "$dir/$file"};
  }
  die("$dir is empty\n") unless @send;
  $_->{'follow'} = 1 for @send;		# follow all symlinks
  BSServer::reply_cpio(\@send);
  return undef;
}

sub getbuildcode {
  my ($cgi) = @_;
  return getcode($cgi, 'build');
}

sub getworkercode {
  my ($cgi) = @_;
  return getcode($cgi, 'worker');
}

sub postrepo {
  my ($cgi, $projid, $repoid, $arch) = @_;

  my @args = ("project=$projid", "repository=$repoid", "arch=$arch");
  push @args, "partition=$BSConfig::partition" if $BSConfig::partition;
  # FIXME: add remote support
  my $projpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'withrepos', 'expandedrepos', @args);
  my $proj = $projpack->{'project'}->[0];
  die("no such project\n") unless $proj && $proj->{'name'} eq $projid;
  my $repo = $proj->{'repository'}->[0];
  die("no such repository\n") unless $repo && $repo->{'name'} eq $repoid;
  my @prp = map {"$_->{'project'}/$_->{'repository'}"} @{$repo->{'path'} || []};
  my $pool = BSSolv::pool->new();
  for my $prp (@prp) {
    BSRepServer::addrepo_scan($pool, $prp, $arch);
  }
  $pool->createwhatprovides();
  my %data;
  for my $p ($pool->consideredpackages()) {
    my $d = $pool->pkg2data($p);
    $data{$d->{'name'}} = $d;
  }
  undef $pool;
  my @data;
  for (sort keys %data) {
    push @data, $data{$_};
    $data[-1]->{'_content'} = $data[-1]->{'name'};
  }
  my $match = $cgi->{'match'};
  $match = "[$match]" unless $match =~ /^[\.\/]?\[/;
  $match = ".$match" if $match =~ /^\[/;
  my $v = BSXPath::valuematch(\@data, $match);
  return {'value' => $v}, $BSXML::collection;
}

sub listpublished {
  my ($dir, $fileok) = @_;
  my @r;
  for my $d (ls($dir)) {
    if ($fileok && -f "$dir/$d") {
      push @r, $d;
      next;
    }
    next unless -d "$dir/$d";
    if ($d =~ /:$/) {
      my $dd = $d;
      chop $dd;
      push @r, map {"$dd:$_"} listpublished("$dir/$d");
    } else {
      push @r, $d;
    }
  }
  return @r;
}

sub publisheddir {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my @res = ();
  if (!defined($projid)) {
    @res = listpublished($extrepodir);
    if ($BSConfig::publishredirect) {
      for (keys %{$BSConfig::publishredirect}) {
        push @res, (split('/', $_, 2))[0];
      }
      @res = BSUtil::unify(@res);
    }
  } elsif (!defined($repoid)) {
    my $prp_ext = $projid;
    $prp_ext =~ s/:/:\//g;
    @res = listpublished("$extrepodir/$prp_ext");
    if ($BSConfig::publishredirect) {
      for (keys %{$BSConfig::publishredirect}) {
        my @p = split('/', $_, 2);
	push @res, $p[1] if $p[0] eq $projid;
      }
      @res = BSUtil::unify(@res);
    }
  } elsif (!defined($arch)) {
    my $extrep = BSUrlmapper::get_extrep("$projid/$repoid");
    @res = listpublished($extrep, 1);
  } else {
    my $extrep = BSUrlmapper::get_extrep("$projid/$repoid");
    return publishedfile($cgi, $projid, $repoid, undef, $arch) if -f "$extrep/$arch";
    if ($cgi->{'view'} && $cgi->{'view'} eq 'ymp') {
      my $binaryname = $arch;
      my $binary;
      my @archs = ls($extrep);
      for my $a (@archs) {
	next if $a eq 'repodata' || $a eq 'repocache';
	next unless -d "$extrep/$a";
	$binary = BSRepServer::YMP::findympbinary("$extrep/$a", $binaryname);
	last if $binary;
      }
      $binary ||= "$extrep/$binaryname";
      my $projpack;
      if (BSServer::have_content()) {
	my $projpackxml = BSServer::read_data(10000000);
	$projpack = BSUtil::fromxml($projpackxml, $BSXML::projpack, 1);
      }
      my $ymp = BSRepServer::YMP::makeymp($projid, $repoid, $binary, $projpack);
      return ($ymp, $BSXML::ymp, 'Content-Type: text/x-suse-ymp');
    }
    @res = ls("$extrep/$arch");
  }
  @res = sort @res;
  @res = map {{'name' => $_}} @res;
  return ({'entry' => \@res}, $BSXML::dir);
}

sub publishedfileinfo {
  my ($cgi, $filepath, $filename) = @_;
  my @s = stat($filepath);
  die("filename: $!\n") unless -f _;
  my $q = {};
  if ($filename =~ /\.(?:$binsufsre)$/) {
    $q = Build::query($filepath, 'evra' => 1, 'description' => 1, 'weakdeps' => 1, 'alldeps' => 1);
    data2utf8xml($q);
  } elsif ($filename =~ /\.ymp$/) {
    my $ymp = readxml($filepath, $BSXML::ymp, 1);

    if ($ymp) {
      my $g0 = $ymp->{'group'}[0];
      $q->{'name'} = $g0->{'name'} if defined $g0->{'name'};
      $q->{'summary'} = $g0->{'summary'} if defined $g0->{'summary'};
      $q->{'description'} = $g0->{'description'} if defined $g0->{'description'};
      $q->{'size'} = $g0->{'size'} if defined $g0->{'size'};
      if ($g0->{'repositories'}) {
	$q->{'recommends'} = [ map {$_->{'name'}} grep {$_->{'recommended'} && $_->{'recommended'} eq 'true'} @{$g0->{'packages'}->{'package'} || []} ];
	$q->{'suggests'} = [ map {$_->{'name'}} grep {!($_->{'recommended'} && $_->{'recommended'} eq 'true')} @{$g0->{'packages'}->{'package'} || []} ];
	delete $q->{'recommends'} unless @{$q->{'recommends'}};
	delete $q->{'suggests'} unless @{$q->{'suggests'}};
      }
    }
  }
  $q->{'size'} = $s[7]  unless defined $q->{'size'};
  $q->{'mtime'} = $s[9] unless defined $q->{'mtime'};
  my $res = { 'filename' => $filename };
  for (qw{name epoch version release arch size mtime summary description provides requires recommends suggests}) {
    $res->{$_} = $q->{$_} if defined $q->{$_};
  }
  return ($res, $BSXML::fileinfo);
}

sub publishedfile {
  my ($cgi, $projid, $repoid, $arch, $filename, $subfilename) = @_;
  $filename .= "/$subfilename" if defined $subfilename;
  my $extrep = BSUrlmapper::get_extrep("$projid/$repoid");
  $extrep .= "/$arch" if defined $arch;
  if (-d "$extrep/$filename") {
    return publisheddir($cgi, $projid, $repoid, "$arch/$filename");
  }
  if ($cgi->{'view'} && $cgi->{'view'} eq 'ymp') {
    my $projpack;
    if (BSServer::have_content()) {
      my $projpackxml = BSServer::read_data(10000000);
      $projpack = BSUtil::fromxml($projpackxml, $BSXML::projpack, 1);
    }
    my $ymp = BSRepServer::YMP::makeymp($projid, $repoid, "$extrep/$filename", $projpack);
    return ($ymp, $BSXML::ymp, 'Content-Type: text/x-suse-ymp');
  }
  die("404 no such file\n") unless -f "$extrep/$filename";
  if ($cgi->{'view'} && $cgi->{'view'} eq 'fileinfo') {
    return publishedfileinfo($cgi, "$extrep/$filename", $filename);
  }
  my $type = 'application/octet-stream';
  $type = 'application/x-rpm' if $filename =~ /\.rpm$/;
  $type = 'application/x-debian-package' if $filename =~ /\.deb$/;
  $type = 'text/xml' if $filename=~ /\.xml$/;
  BSServer::reply_file("$extrep/$filename", "Content-Type: $type");
  return undef;
}

sub published_status {
  my ($cgi, $projid, $repoid) = @_;
  my $repoinfo = BSUtil::retrieve("$reporoot/$projid/$repoid/:repoinfo", 1) || {};
  my $status = { 'code' => ($repoinfo->{'code'} || 'unknown') };
  $status->{'starttime'} = $repoinfo->{'starttime'} if $repoinfo->{'starttime'};
  $status->{'endtime'} = $repoinfo->{'endtime'} if $repoinfo->{'endtime'};
  $status->{'buildid'} = $repoinfo->{'publishid'} if $repoinfo->{'publishid'};
  $status->{'details'} = $repoinfo->{'details'} if $repoinfo->{'details'};
  return ($status, $BSXML::buildstatus);
}

sub getrelsync {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my $prp = "$projid/$repoid";
  my $relsyncdata;
  my $relsync_merge = BSUtil::retrieve("$reporoot/$prp/$arch/:relsync.merge", 1);
  if ($relsync_merge) {
    my $relsync = BSUtil::retrieve("$reporoot/$prp/$arch/:relsync", 1) || {};
    $relsync = { %$relsync, %$relsync_merge };
    $relsyncdata = BSUtil::tostorable($relsync);
  } else {
    $relsyncdata = readstr("$reporoot/$prp/$arch/:relsync");
    $relsyncdata ||= BSUtil::tostorable({});
  }
  return ($relsyncdata, 'Content-Type: application/octet-stream');
}

sub postrelsync {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my $prp = "$projid/$repoid";

  my $newdata = BSServer::read_data(10000000);
  my $new = BSUtil::fromstorable($newdata);
  die("no data\n") unless $new;

  local *F;
  BSUtil::lockopen(\*F, '+>>', "$reporoot/$prp/$arch/:relsync.max");
  my $relsyncmax;
  if (-s "$reporoot/$prp/$arch/:relsync.max") {
    $relsyncmax = BSUtil::retrieve("$reporoot/$prp/$arch/:relsync.max", 2);
  }
  $relsyncmax ||= {};
  my $changed;
  for my $packid (keys %$new) {
    if ($packid =~ /\//) {
      next if defined($relsyncmax->{$packid}) && $relsyncmax->{$packid} >= $new->{$packid};
      $relsyncmax->{$packid} = $new->{$packid};
    } else {
      next unless $new->{$packid} =~ /^(.*)\.([^-]*)$/;
      next if defined($relsyncmax->{"$packid/$1"}) && $relsyncmax->{"$packid/$1"} >= $2;
      $relsyncmax->{"$packid/$1"} = $2;
    }
    $changed = 1;
  }
  BSUtil::store("$reporoot/$prp/$arch/:relsync.max.new", "$reporoot/$prp/$arch/:relsync.max", $relsyncmax) if $changed;
  close(F);

  if ($changed) {
    forwardevent($cgi, 'relsync', $projid, undef, $repoid, $arch);
  }
  return $BSStdServer::return_ok;
}

sub putdispatchprios {
  my ($cgi) = @_;
  mkdir_p($uploaddir);
  die("upload failed\n") unless BSServer::read_file("$uploaddir/dispatchprios.$$");
  my $prios = readxml("$uploaddir/dispatchprios.$$", $BSXML::dispatchprios);
  unlink("$uploaddir/dispatchprios.$$");
  mkdir_p($jobsdir);
  BSUtil::store("$jobsdir/.dispatchprios", "$jobsdir/dispatchprios", $prios);
  return $BSStdServer::return_ok;
}

sub getdispatchprios {
  my $prios = BSUtil::retrieve("$jobsdir/dispatchprios", 1) || {};
  return ($prios, $BSXML::dispatchprios);
}

sub listjobarchs {
  my ($cgi) = @_;
  my @res = grep {-d "$jobsdir/$_"} ls ($jobsdir);
  @res = sort @res;
  @res = map {{'name' => $_}} @res;
  return ({'entry' => \@res}, $BSXML::dir);
}

sub listjobs {
  my ($cgi, $arch) = @_;
  my @b = grep {!/^\./} ls("$jobsdir/$arch");
  @b = grep {!/:cross$/} @b;
  my %locked = map {$_ => 1} grep {/:status$/} @b;
  @b = grep {!/:(?:dir|status|new)$/} @b;
  my @res = map {{'name' => $_}} @b;
  return ({'entry' => \@res}, $BSXML::dir);
}

sub addjob {
  my ($cgi, $arch, $job) = @_;
  my $infoxml = BSServer::read_data(100000000);
  # just check xml structure
  die("job '$job' already exists\n") if -e "$jobsdir/$arch/$job";
  my $info = XMLin($BSXML::buildinfo, $infoxml);
  mkdir_p("$jobsdir/$arch");
  writestr("$jobsdir/$arch/.$job.$$", "$jobsdir/$arch/$job", $infoxml);
  if ($info->{'hostarch'} && $arch ne $info->{'hostarch'}) {
    mkdir_p("$jobsdir/$info->{'hostarch'}");
    BSUtil::touch("$jobsdir/$info->{'hostarch'}/$job:$arch:cross");
  }
  return $BSStdServer::return_ok;
}

sub getjob {
  my ($cgi, $arch, $job) = @_;
  die("404 no such job\n") unless -e "$jobsdir/$arch/$job";
  if ($cgi->{'view'}) {
    die("unknown view '$cgi->{'view'}'\n") unless $cgi->{'view'} eq 'status';
    my $js = readxml("$jobsdir/$arch/$job:status", $BSXML::jobstatus, 1);
    $js ||= {'job' => $job, 'code' => 'scheduled'};
    return ($js, $BSXML::jobstatus);
  }
  my $info = readxml("$jobsdir/$arch/$job", $BSXML::buildinfo);
  return ($info, $BSXML::buildinfo);
}

sub deljob {
  my ($cgi, $arch, $job) = @_;
  return $BSStdServer::return_ok unless -e "$jobsdir/$arch/$job";
  local *F;
  if (! -e "$jobsdir/$arch/$job:status") {
    my $js = {'code' => 'deleting'};
    if (BSUtil::lockcreatexml(\*F, "$jobsdir/$arch/.repo.$$", "$jobsdir/$arch/$job:status", $js, $BSXML::jobstatus)) {
      if (-d "$jobsdir/$arch/$job:dir") {
        BSUtil::cleandir("$jobsdir/$arch/$job:dir");
        rmdir("$jobsdir/$arch/$job:dir");
      }
      unlink("$jobsdir/$arch/$job");
      unlink("$jobsdir/$arch/$job:status");
      close F;
      return $BSStdServer::return_ok;
    }
  }
  my $js = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$arch/$job:status", $BSXML::jobstatus);
  if ($js->{'code'} eq 'building') {
    my $req = {
      'uri' => "$js->{'uri'}/discard",
      'timeout' => 60,
    };   
    eval {
      BSRPC::rpc($req, undef, "jobid=$js->{'jobid'}");
    };   
    warn("kill $job: $@") if $@;
  }
  if (-d "$jobsdir/$arch/$job:dir") {
    BSUtil::cleandir("$jobsdir/$arch/$job:dir");
    rmdir("$jobsdir/$arch/$job:dir");
  }
  updateredisjobstatus($arch, $job);
  unlink("$jobsdir/$arch/$job");
  unlink("$jobsdir/$arch/$job:status");
  close F;
  return $BSStdServer::return_ok;
}

sub postmdload {
  my ($cgi) = @_;

  my $newdata = BSServer::read_data(200000000);
  my $newmdload = BSUtil::fromstorable($newdata);
  die("no data\n") unless $newmdload;
  return $BSStdServer::return_ok unless %$newmdload;
  local *F;
  BSUtil::lockopen(\*F, '+>>', "$jobsdir/mdload");
  my $oldmdload = {};
  if (-s "$jobsdir/mdload") {
    $oldmdload = BSUtil::retrieve("$jobsdir/mdload");
  }
  for (keys %$newmdload) {
    if (!$oldmdload->{$_} || $oldmdload->{$_}->[0] < $newmdload->{$_}->[0]) {
      $oldmdload->{$_} = $newmdload->{$_};
    } elsif ($newmdload->{$_}->[2] && $oldmdload->{$_}->[2] < $newmdload->{$_}->[2]) {
      ($oldmdload->{$_}->[2], $oldmdload->{$_}->[3]) = ($newmdload->{$_}->[2], $newmdload->{$_}->[3]);
    }
  }
  my $prunetime = time() - 50 * 86400;
  for (keys %$oldmdload) {
    my $l = $oldmdload->{$_};
    delete $oldmdload->{$_} if $l->[0] < $prunetime && $l->[2] < $prunetime;
  }
  BSUtil::store("$jobsdir/.mdload.$$", "$jobsdir/mdload", $oldmdload);
  close F;
  return $BSStdServer::return_ok;
}

sub idleworkerjob {
  my ($cgi, $arch, $job) = @_;
  local *F;
  my $js = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$arch/$job:status", $BSXML::jobstatus, 1);
  if ($js) {
    # be extra careful here not to terminate jobs that run on different workers
    $js->{'code'} = 'different' if $cgi->{'jobid'} && ($js->{'jobid'} || '') ne $cgi->{'jobid'};
    if ($js->{'code'} eq 'building' && (!defined($js->{'workerid'}) || $js->{'workerid'} eq $cgi->{'workerid'})) {
      print "restarting build of job $arch/$job\n";
      updateredisjobstatus($arch, $job);
      unlink("$jobsdir/$arch/$job:status");
    }
    close F;
  }
  return $BSStdServer::return_ok;
}

sub setdispatchdetails {
  my ($cgi, $arch, $job) = @_;
  my $info = readxml("$jobsdir/$arch/$job", $BSXML::buildinfo, 1);
  if ($info) {
    my $ev = { type => 'dispatchdetails', job => $job, details => $cgi->{'details'}};
    my $evname = "dispatchdetails:$job";
    mkdir_p("$eventdir/$arch");
    writexml("$eventdir/$arch/.$evname.$$", "$eventdir/$arch/$evname", $ev, $BSXML::event);
    BSUtil::ping("$eventdir/$arch/.ping");
  }
  return $BSStdServer::return_ok;
}

sub failjob {
  my ($cgi, $arch, $job) = @_;
  local *F;
  return unless -e "$jobsdir/$arch/$job";
  if (!BSUtil::lockopen(\*F, '+>>', "$jobsdir/$arch/$job:status", 1))  {
    die("job lock failed!\n");
  }
  if (-s "$jobsdir/$arch/$job:status") {
    close F;
    die("job is building!\n");
  }
  my $info = readxml("$jobsdir/$arch/$job", $BSXML::buildinfo, 1);
  if (!$info) {
    unlink("$jobsdir/$arch/$job:status");
    close F;
    die("job disappeared!\n");
  }
  my $projid = $info->{'project'} || $info->{'path'}->[0]->{'project'};
  my $repoid = $info->{'repository'} || $info->{'path'}->[0]->{'repository'};

  my $dir = "$jobsdir/$arch/$job:dir";
  mkdir_p($dir);
  BSUtil::cleandir($dir);
  writestr("$dir/logfile", undef, $cgi->{'message'});
  my $now = time();
  my $jobstatus = { code => 'finished', result => 'failed', starttime => $now, endtime => $now,
                    workerid => 'dispatcher', 'hostarch' => '' };
  notify_jobresult($job, $info, $jobstatus, "$projid/$repoid/$arch");
  my $ev = {'type' => 'built', 'arch' => $arch, 'job' => $job};
  writexml("$jobsdir/$arch/.$job:status", "$jobsdir/$arch/$job:status", $jobstatus, $BSXML::jobstatus);
  updateredisjobstatus($arch, $job, $info, 'finished');
  close F;
  dirty($projid, $repoid, $arch);
  mkdir_p("$eventdir/$arch");
  writexml("$eventdir/$arch/.finished:$job$$", "$eventdir/$arch/finished:$job", $ev, $BSXML::event);
  BSUtil::ping("$eventdir/$arch/.ping");
}

sub putconfiguration {
  my ($cgi) = @_;
  mkdir_p($uploaddir);
  my $uploaded = BSServer::read_file("$uploaddir/$$");
  die("upload failed\n") unless $uploaded;
  my $configurationxml = readstr("$uploaddir/$$");
  unlink("$uploaddir/$$");
  my $oldconfigurationxml = readstr("$BSConfig::bsdir/configuration.xml", 1);
  if ($configurationxml ne ($oldconfigurationxml || '')) {
    BSUtil::fromxml($configurationxml, $BSXML::configuration);	# test xml syntax
    writestr("$BSConfig::bsdir/.configuration.xml", "$BSConfig::bsdir/configuration.xml", $configurationxml);
  }
  # signal schedulers and publisher
  forwardevent($cgi, 'configuration', '');
  forwardevent($cgi, 'configuration', '', undef, undef, 'publish') if -d "$eventdir/publish";
  return $BSStdServer::return_ok;
}

sub getconfiguration {
  my $configuration = readxml("$BSConfig::bsdir/configuration.xml", $BSXML::configuration, 1) || {};
  return ($configuration, $BSXML::configuration);
}

sub getajaxstatuslist {
  my ($cgi) = @_;
  my $conf = $BSServer::request->{'conf'};
  my $param = { 'uri' => '/ajaxstatus' };
  my @ajaxstatuslist;
  for (0 .. scalar(@{$conf->{'ajaxpartitions'} || []})) {
    $param->{'handoffpath'} = BSStdServer::get_handoffpath_aidx($conf, $_ || '');
    push @ajaxstatuslist, BSHandoff::rpc($param, $BSXML::ajaxstatus);
  }
  return ({ 'ajaxstatus' => \@ajaxstatuslist }, $BSXML::ajaxstatuslist);
}

sub getajaxstatus {
  my ($cgi) = @_;
  my $conf = $BSServer::request->{'conf'};
  if (!$BSStdServer::isajax) {
    my $param = { 'uri' => '/ajaxstatus' };
    $param->{'handoffpath'} = BSStdServer::get_handoffpath_aidx($conf, $cgi->{'aidx'});
    BSHandoff::handoff($param);
  }
  my $r = BSWatcher::getstatus();
  $r->{'aidx'} = $conf->{'aidx'} if $conf->{'aidx'};
  return ($r, $BSXML::ajaxstatus);
}

sub getworkercap {
  my ($cgi, $workerid) = @_;

  my $worker_cap;
  for my $workerstate (qw{idle building away dead down}) {
    $worker_cap ||= readxml("$workersdir/$workerstate/$workerid", $BSXML::worker, 1);
  }
  die("404 unknown worker\n") unless $worker_cap;
  delete $worker_cap->{$_} for qw{port ip uri};
  return ($worker_cap, $BSXML::worker);
}

sub checkconstraints {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;

  my $constraints;
  if (BSServer::have_content()) {
    mkdir_p($uploaddir);
    my $uploaded = BSServer::read_file("$uploaddir/$$");
    die("upload failed\n") unless $uploaded;
    $constraints = readxml("$uploaddir/$$", $BSXML::constraints);
    unlink("$uploaddir/$$");
  }

  # get the build config
  my $pconf = BSRPC::rpc("$BSConfig::srcserver/getconfig", undef, "project=$projid", "repository=$repoid");
  my $bconf = Build::read_config($arch, [ split("\n", $pconf)] );

  # create job info data
  my $info = {
    'project' => $projid ,
    'repoid' => $repoid,
    'arch' => $arch,
    'package' >= $packid,
  };
  $info->{'hostarch'} = $bconf->{'hostarch'} if $bconf->{'hostarch'};

  # merge constraints
  $constraints = BSDispatcher::Constraints::overwriteconstraints($info, $constraints) if $constraints->{'overwrite'};
  my @list = map { [ split(' ', $_) ] } @{$bconf->{'constraint'}};
  my $prjconfconstraint = BSDispatcher::Constraints::list2struct($BSXML::constraints, \@list);
  $constraints = $constraints ? BSDispatcher::Constraints::mergeconstraints($prjconfconstraint, $constraints) : $prjconfconstraint;

  my %harchcando;         # can the harch build an arch?
  for my $harch (keys %BSCando::cando) {
    for my $arch (@{$BSCando::cando{$harch}}) {
      if ($arch =~ /^([^:]+):(.+)$/) {
        $harchcando{"$harch/$1"} = $2;
      } else {
        $harchcando{"$harch/$arch"} = '';
      }
    }
  }

  # check all known workers
  my $buildarch = $info->{'hostarch'} || $arch;
  my @comp_workers;
  for my $workerstate (qw{idle building away dead down}) {
    my @workernames = sort(grep {!/^\./} BSUtil::ls("$workersdir/$workerstate"));
    for my $workername (@workernames) {
      my ($harch) = split(':', $workername, 2);
      next unless exists($harchcando{"$harch/$buildarch"});
      my $worker = readxml("$workersdir/$workerstate/$workername", $BSXML::worker, 1);
      my $helper = $harchcando{"$harch/$buildarch"};
      next if $helper && $worker->{hardware} && exists($worker->{hardware}->{nativeonly});
      next if $BSConfig::dispatch_constraint && !$BSConfig::dispatch_constraint->($info, $worker, $constraints);
      next if $constraints && BSDispatcher::Constraints::oracle($worker, $constraints) <= 0;
      push @comp_workers, $workername;
    }
  }
  @comp_workers = BSUtil::unify(sort @comp_workers);
  @comp_workers = map {{'name' => $_}} @comp_workers;
  return ({'entry' => \@comp_workers}, $BSXML::dir);
}

sub registry_manifest {
  my ($cgi, $regrepo, $manifest) = @_;
  my $repodir = "$registrydir/$regrepo";
  die("404 NAME_UNKNOWN\n") unless -d $repodir;
  if ($manifest =~ /^sha256-([0-9a-f]{64})\.sig$/) {
    my $digest = "sha256:$1";
    my $sigs = BSUtil::retrieve("$repodir/:cosign", 1);
    $manifest = $sigs->{'digests'}->{$digest} if $sigs && $sigs->{'digests'}->{$digest};
  } elsif ($manifest =~ /^sha256-([0-9a-f]{64})\.att$/) {
    my $digest = "sha256:$1";
    my $sigs = BSUtil::retrieve("$repodir/:cosign", 1);
    $manifest = $sigs->{'attestations'}->{$digest} if $sigs && $sigs->{'attestations'}->{$digest};
  }
  my $mani_json;
  my $is_manifest;
  if ($manifest !~ /^sha256:[0-9a-f]{64}$/s) {
    $mani_json = readstr("$repodir/:tags/$manifest", 1);
  } else {
    $mani_json = readstr("$repodir/:manifests/$manifest", 1);
    $is_manifest = 1;
  }
  if (!$mani_json && $is_manifest) {
    # check if this is a referrer manifest
    my $referrerinfo = -s "$repodir/:referrerinfo" ? BSUtil::retrieve("$repodir/:referrerinfo", 1) : undef;
    my $subject = ($referrerinfo || {})->{$manifest};
    if ($subject) {
      my $referrers = -s "$repodir/:referrers/$subject" ? BSUtil::retrieve("$repodir/:referrers/$subject", 1) : undef;
      my $r = (grep {$_->[0] eq $manifest} @{$referrers || []})[0];
      $mani_json = $r->[1] if $r;
    }
  }
  # sigh, need the type
  die("404 MANIFEST_UNKNOWN\n") unless $mani_json;
  my $mani_id = "sha256:".Digest::SHA::sha256_hex($mani_json);
  my $mani = JSON::XS::decode_json($mani_json);
  my $manifestct = 'application/vnd.docker.distribution.manifest.v2+json';
  my $manifestlistct = 'application/vnd.docker.distribution.manifest.list.v2+json';
  my $ct = $mani->{'mediaType'} || $manifestct;
  my $accept = BSServer::header('Accept');
  if ($accept && $accept ne '*/*') {
    # check if the client accepts the content type
    my @accept = split(/[\s,]+/, $accept);
    s/;.*// for @accept;
    my %accept = map {lc($_) => 1} @accept;
    if (!$accept{lc($ct)} && !$accept{'*/*'}) {
      if (!$is_manifest && lc($ct) eq lc($manifestlistct) && $accept{lc($manifestct)}) {
	my $digest = BSRepServer::Registry::select_manifest($mani, 'amd64', 'linux');
	die("404 MANIFEST_UNKNOWN\n") unless $digest;
	return registry_manifest($cgi, $regrepo, $digest);
      }
      die("406 MANIFEST_UNACCEPTED\n");
    }
  }
  my @hdrs = ("Content-Type: $ct", "Docker-Content-Digest: $mani_id", "Etag: \"$mani_id\"");
  push @hdrs, 'Cache-Control: max-age=2678400' if $is_manifest;
  BSRegistryServer::reply($mani_json, "Content-Type: $ct", "Docker-Content-Digest: $mani_id", "Etag: \"$mani_id\"");
  return undef;
}

sub registry_manifestinfo_gun {
  my ($cgi, $gun, $regrepo, $manifest) = @_;
  my %regs;
  my @pc = @$BSConfig::publish_containers;
  while (@pc) {
    my (undef, $v) = splice(@pc, 0, 2);
    $regs{$_} = 1 for @{ref($v) ? $v : [ $v ]};
  }
  delete $regs{'local'};
  my $foundone;
  for my $regname (sort keys %regs) {
    my $registry = $BSConfig::container_registries->{$regname};
    next unless $registry && $registry->{'manifestinfos'};
    my $reggun = $registry->{'notary_gunprefix'} || $registry->{'server'};
    $reggun =~ s/^https?:\/\///;
    next unless $gun eq $reggun;
    $foundone = 1;
    my $fd;
    next unless open ($fd, '<', "$registry->{'manifestinfos'}/$regrepo/$manifest");
    my @hdrs = ('Content-Type: application/json');
    BSServer::reply_file($fd, @hdrs);
    return undef;
  }
  die("404 MANIFESTINFO_UNKNOWN\n") if $foundone;
  die("404 NAME_UNKNOWN\n");
}

sub registry_manifestinfo {
  my ($cgi, $regrepo, $manifest) = @_;
  my $repodir = "$registrydir/$regrepo";
  die("400 DIGEST_INVALID\n") unless $manifest =~ /^sha256:[0-9a-f]{64}$/;
  if (! -f "$repodir/:info") {
    if ($BSConfig::publish_containers && $BSConfig::container_registries && $regrepo =~ /^([^\/]+\.[^\/]+)\/(.*)$/) {
      return registry_manifestinfo_gun($cgi, $1, $2, $manifest);
    }
    die("404 NAME_UNKNOWN\n");
  }
  my $fd;
  open ($fd, '<', "$repodir/:manifestinfos/$manifest") || die("404 MANIFESTINFO_UNKNOWN\n");
  my @hdrs = ('Content-Type: application/json');
  BSServer::reply_file($fd, @hdrs);
  return undef;
}

sub registry_blob {
  my ($cgi, $regrepo, $blob) = @_;
  die("400 DIGEST_INVALID\n") unless $blob =~ /^sha256:[0-9a-f]{64}$/s;
  my $repodir = "$registrydir/$regrepo";
  die("404 NAME_UNKNOWN\n") unless -f "$repodir/:info";
  my $fd;
  open($fd, '<', "$repodir/:blobs/$blob") || die("404 BLOB_UNKNOWN\n");
  my @s = stat($fd);
  my $size = $s[7];
  my $req = $BSServer::request;
  my $range = $req->{'action'} eq 'GET' ? BSServer::header('Range') : undef;
  my @rangehdr;
  if ($range && $range =~ /^bytes=(\d*)-(\d*)$/ && (defined($1) || defined($2))) {
    my ($start, $end) = ($1, $2);
    $end = $size - 1 if $end eq '';
    ($start, $end) = ($size - $end, $size - 1) if $start eq '';
    $start = 0 if $start < 0;
    die("416 RANGE_NOT_SATISFIABLE $size\n") if $start >= $size || $end < $start;
    $end = $size - 1 if $end >= $size;
    @rangehdr = ("Content-Range: bytes $start-$end/$size");
    $start == 0 || defined(sysseek($fd, $start, Fcntl::SEEK_SET)) || die("sysseek: $!\n");
    $size = $end - $start + 1;
  }
  my $param = {'filename' => $fd};
  my @hdrs = ("Content-Type: application/octet-stream", "Content-Length: $size", @rangehdr, "Docker-Content-Digest: $blob", "Etag: \"$blob\"", $BSRegistryServer::registry_api_hdr);
  push @hdrs, 'Cache-Control: max-age=2678400';
  unshift @hdrs, 'Status: 206 Partial Content' if @rangehdr;
  BSServer::reply_file($fd, @hdrs);
  return undef;
}

sub registry_sigstore {
  my ($cgi, $regrepo, $sig) = @_;
  my $digest;
  if ($sig =~ /\@/) {
    ($sig, $digest) = split('@', $sig, 2);
    die("404 NAME_UNKNOWN\n") unless $sig =~ s/^signature-(\d+)$/$1/s;
    $digest =~ s/=/:/;
  } else {
    $digest = $sig;
    $sig = undef;
  }
  die("400 DIGEST_INVALID\n") unless $digest =~ /^sha256:[0-9a-f]{64}$/s;
  my $repodir = "$registrydir/$regrepo";
  die("404 NAME_UNKNOWN\n") unless -f "$repodir/:info";
  my $sigs = BSUtil::retrieve("$repodir/:sigs", 1) || {};
  my $d = ($sigs->{'digests'} || {})->{$digest};
  if (defined($sig)) {
    die("404 NAME_UNKNOWN\n") unless $d;
    die("404 NAME_UNKNOWN\n") unless $sig >= 1 && @$d >= $sig;
    BSServer::reply($d->[$sig - 1]->[1], 'Content-Type: application/octet-stream');
  } else {
    my @sigs = map { BSConSign::sig2openshift($digest, $_->[1]) } @{$d || []};
    BSRegistryServer::reply({ 'signatures' => \@sigs });
  }
  return undef;
}

sub registry_referrers {
  my ($cgi, $regrepo, $subject) = @_;
  die("400 DIGEST_INVALID\n") unless $subject =~ /^sha256:[0-9a-f]{64}$/s;
  my $repodir = "$registrydir/$regrepo";
  die("404 NAME_UNKNOWN\n") unless -f "$repodir/:info";
  die("404 MANIFEST_UNKNOWN\n") unless -s "$repodir/:manifests/$subject";
  my $referrers = -s "$repodir/:referrers/$subject" ? BSUtil::retrieve("$repodir/:referrers/$subject", 1) : undef;
  my @manifest_data;
  for my $r (@{$referrers || []}) {
    next if $cgi->{'artifactType'} && ($r->[2] || '') ne $cgi->{'artifactType'};
    my $m = eval { JSON::XS::decode_json($r->[1]) };
    next unless $m && $m->{'mediaType'};
    my $md = { 'mediaType' => $m->{'mediaType'}, 'size' => length($r->[1]), 'digest' => $r->[0]};
    $md->{'artifactType'} = $r->[2] if $r->[2];
    $md->{'annotations'} = $m->{'annotations'} if $m->{'annotations'};
    push @manifest_data, $md;
  }
  my $manilist = BSContar::create_dist_manifest_list_data(\@manifest_data, 1);
  my $manilist_json = BSContar::create_dist_manifest_list($manilist);
  BSServer::reply($manilist_json, 'Content-Type: application/json');
}

sub registry_taglist {
  my ($cgi, $regrepo) = @_;
  my $repodir = "$registrydir/$regrepo";
  die("404 NAME_UNKNOWN\n") unless -f "$repodir/:info";
  my @tags = sort(grep {!/^\./} ls("$repodir/:tags"));
  my @hdrs;
  BSRegistryServer::paginate($cgi, \@tags, "/v2/$regrepo/tags/list", \@hdrs);
  my $ret = {
    'name' => $regrepo,
    'tags' => \@tags,
  };
  BSRegistryServer::reply($ret, @hdrs);
  return undef;
}

sub registry_info {
  my ($cgi, $regrepo) = @_;
  my $repodir = "$registrydir/$regrepo";
  my $ret = BSUtil::retrieve("$repodir/:info", 1);
  die("404 NAME_UNKNOWN\n") unless $ret;
  BSRegistryServer::reply($ret);
  return undef;
}

sub registry_catalog {
  my ($cgi) = @_;
  my $registries = BSUtil::retrieve("$registrydir/:repos", 1) || {};
  my @repos = sort keys %$registries;
  my $ret = {
    'repositories' => \@repos,
  };
  BSRegistryServer::reply($ret);
  return undef;
}

sub registry_tuf {
  my ($cgi, $gunprefix, $regrepo, $filename) = @_;
  my $repodir = "$registrydir/$regrepo";
  my $sha256sum;
  if ($filename =~ /^(.*)\.([a-f0-9]{64})\.json$/) {
    $filename = "$1.json";
    $sha256sum = $2;
  }
  die("404 METADATA_NOT_FOUND\n") unless $filename eq 'root.json' || $filename eq 'targets.json' || $filename eq 'snapshot.json' || $filename eq 'timestamp.json' || $filename eq 'snapshot.key' || $filename eq 'timestamp.key';
  my $tuf = BSUtil::retrieve("$repodir/:tuf", 1);
  die("404 METADATA_NOT_FOUND\n") unless $tuf;
  if ($filename =~ /(.*)\.json$/) {
    my $role = $1;
    my $data = $tuf->{$role};
    die("404 METADATA_NOT_FOUND\n") unless $data;
    if ($sha256sum && Digest::SHA::sha256_hex($data) ne $sha256sum) {
      # also look in :tuf.old if we want a consistent entry
      $tuf = BSUtil::retrieve("$repodir/:tuf.old", 1) || {};
      $data = $tuf->{$role};
      die("404 METADATA_NOT_FOUND\n") unless $data && Digest::SHA::sha256_hex($data) eq $sha256sum;
    }
    if (!$sha256sum && $role eq 'timestamp' && $BSConfig::sign && $tuf->{'timestamp_expires'} && $tuf->{'timestamp_privkey'}) {
      my $now = time();
      if ($tuf->{'timestamp_expires'} < $now + 3600) {
        $tuf = BSRepServer::Registry::extend_timestamp($repodir, $tuf, $now + 14 * 24 * 3600);
        die("404 METADATA_NOT_FOUND\n") unless $tuf && $tuf->{'timestamp'};
	$data = $tuf->{'timestamp'};
      }
    }
    my @hdrs = ('Content-Type: application/json');
    BSRegistryServer::reply($data, @hdrs);
    return undef;
  }
  if ($filename =~ /(.*)\.key$/) {
    my $role = $1;
    my $root = $tuf->{'root'};
    die("404 METADATA_NOT_FOUND\n") unless $root;
    $root = JSON::XS::decode_json($root);
    my $keyid = $root->{'roles'}->{$role}->{'keyids'}->[0];
    die("404 METADATA_NOT_FOUND\n") unless $keyid;
    my $key = $root->{'keys'}->{$keyid};
    die("404 METADATA_NOT_FOUND\n") unless $key;
    BSRegistryServer::reply($key);
    return undef;
  }
  die("404 METADATA_NOT_FOUND\n");
}

sub registry_version {
  my ($cgi) = @_;
  BSRegistryServer::reply({});
  return undef;
}

sub slsa_addrefs {
  my ($cgi, $refprpa) = @_;
  my $refs = BSUtil::fromstorable(BSServer::read_data(1000000000));
  my $configs = delete $refs->{'_config'};
  for my $prpa (sort keys %$refs) {
    BSRepServer::SLSA::add_references($prpa, $refprpa, $refs->{$prpa}, $configs);
  }
  return $BSStdServer::return_ok;
}

sub slsa_getfile {
  my ($cgi, $projid, $repoid, $arch, $filename, $digest) = @_;
  my $view = $cgi->{'view'} || '';
  die("bad digest '$digest'\n") unless $digest =~ /^[0-9a-f]{64}$/;
  my $prpa = "$projid/$repoid/$arch";
  if ($view eq 'refs') {
    my @refs = BSRepServer::SLSA::get_references($prpa, $digest);
    for my $ref (@refs) {
      my ($refprojid, $refrepoid, $refarch) = split('/', $ref);
      $ref = {
	'project' => $refprojid,
	'repository' => $refrepoid,
	'arch' => $refarch,
      };
    }
    my $fileinfo = {
      'filename' => $filename,
      'provides_ext' => [ {
	'dep' => $digest,
	'requiredby' => \@refs,
      } ],
    };
    return ($fileinfo, $BSXML::fileinfo);
  }
  die("unknown view '$view'\n") if $view;
  my $fd = BSRepServer::SLSA::openfile($prpa, $digest, $filename);
  my $type = 'application/octet-stream';
  $type = 'application/x-rpm' if $filename =~ /\.rpm$/;
  $type = 'application/x-debian-package' if $filename =~ /\.deb$/;
  BSServer::reply_file($fd, "Content-Type: $type");
  return undef;
}

sub hello {
  my ($cgi) = @_;
  my $part = "";
  $part = "partition=\"$BSConfig::partition\" " if $BSConfig::partition;
  return "<hello name=\"Package Repository Ajax Server\" $part/>\n" if $BSStdServer::isajax;
  return "<hello name=\"Package Repository Server\" $part/>\n";
}

my $dispatches = [
  '/' => \&hello,

  '!rw :' => undef,
  '!- GET:' => undef,
  '!- HEAD:' => undef,

  'POST:/build/$project cmd=move oproject:project' => \&moveproject,
  'POST:/build/$project/$repository/$arch/_repository cmd=missingdodresources resource:* partition:?' => \&missingdodresources,
  'POST:/build/$project/$repository/$arch/_repository match:' => \&postrepo,
  '/build/$project/$repository/$arch package* view:? withbininfocookie:bool?' => \&getpackagelist_build,
  '/build/$project/$repository/$arch/_builddepinfo package* view:?' => \&getbuilddepinfo,
  '/build/$project/$repository/$arch/_jobhistory package* code:* limit:num? endtime_start:num? endtime_end:num?' => \&getjobhistory,
  'POST:/build/$project/$repository/$arch/_relsync' => \&postrelsync,
  '/build/$project/$repository/$arch/_relsync' => \&getrelsync,
  'POST:/build/$project/$repository/$arch/$package cmd=copy oproject:project? opackage:package? orepository:repository? setupdateinfoid:? resign:bool? setrelease:? remoteurl:?' => \&copybuild,
  'POST:/build/$project/$repository/$arch/$package' => \&uploadbuild,
  '!worker,rw /build/$project/$repository/$arch/$package:package_repository view:? binary:filename* nometa:bool? noajax:bool? nosource:bool? noimport:bool? withmd5:bool? module* withccache:bool? withevr:bool? copybuild:bool? aggregatemode:bool?' => \&getbinarylist,
  'POST:/build/$project/$repository/$arch/$package_repositorybuild/_buildinfo add:* internal:bool? debug:bool? deps:bool?' => \&getbuildinfo_post,
  '/build/$project/$repository/$arch/$package/_buildinfo add:* internal:bool? debug:bool? deps:bool?' => \&getbuildinfo,
  '/build/$project/$repository/$arch/$package/_reason' => \&getbuildreason,
  '/build/$project/$repository/$arch/$package/_status' => \&getbuildstatus,
  '/build/$project/$repository/$arch/$package/_jobstatus' => \&getjobstatus,
  '/build/$project/$repository/$arch/$package/_history limit:num?' => \&getbuildhistory,
  '/build/$project/$repository/$arch/$package/_buildstats limit:num?' => \&getbuildstats,
  '/build/$project/$repository/$arch/$package/_log nostream:bool? start:intnum? end:num? handoff:bool? last:bool? lastsucceeded:bool? view:?' => \&getlogfile,
  '/build/$project/$repository/$arch/$package:package_repository/$filename view:? withfilelist:bool? module*' => \&getbinary,
  'PUT:/build/$project/$repository/$arch/_repository/$filename ignoreolder:bool? wipe:bool?' => \&putbinary,
  'DELETE:/build/$project/$repository/$arch/_repository/$filename' => \&delbinary,
  'PUT:/build/_dispatchprios' => \&putdispatchprios,
  '/build/_dispatchprios' => \&getdispatchprios,

  # src server calls
  'POST:/event $type: $project $package? repository? arch? job? worker:job?' => \&forwardevent,

  # worker capabilities
  '/worker/$workerid' => \&getworkercap,
  'POST:/worker cmd=checkconstraints $project $repository $arch $package' => \&checkconstraints,

  # worker calls
  '!worker /worker $arch $port $state: workerid? working:bool? memory:num? disk:num? buildarch:arch* tellnojob:bool? proto:?' => \&workerstate,
  '!worker /getbuildcode' => \&getbuildcode,
  '!worker /getworkercode' => \&getworkercode,
  '!worker POST:/putjob $arch $job $jobid $code:? now:num? kiwitree:bool? workerid?' => \&putjob,
  '!worker POST:/workerdispatched $arch $job $jobid hostarch:arch port proto:? workerid?' => \&workerdispatched,
  '!worker /getbinaries $project $repository $arch binaries: nometa:bool? metaonly:bool? workerid? now:num? module* withannotation:bool?' => \&getbinaries,
  '!worker /getbinaryversions $project $repository $arch binaries: nometa:bool? workerid? now:num? module* withevr:bool?' => \&getbinaryversions,
  '!worker /getjobdata $arch $job $jobid workerid?' => \&getjobdata,
  '!worker /getpackagebinaryversionlist $project $repository $arch $package* withcode:bool? workerid?' => \&getpackagebinaryversionlist,
  '!worker /badpackagebinaryversionlist $project $repository $arch $package* workerid?' => \&badpackagebinaryversionlist,
  '!worker /getpreinstallimageinfos $prpa+ match:? workerid?' => \&getpreinstallimageinfos,
  '/getobsgendiffdata $project $repository $arch jobid? workerid?' => \&getobsgendiffdata,

  # published files
  '/published' => \&publisheddir,
  '/published/$project' => \&publisheddir,
  '/published/$project/$repository view=status' => \&published_status,
  '/published/$project/$repository' => \&publisheddir,
  '/published/$project/$repository/$arch:filename view:?' => \&publisheddir,
  '/published/$project/$repository/$arch:filename/$filename view:?' => \&publishedfile,
  '/published/$project/$repository/$arch:filename/$filename/$subfilename:filename view:?' => \&publishedfile,

  # jobs
  '/jobs' => \&listjobarchs,
  'POST:/jobs/_mdload' => \&postmdload,
  '/jobs/$arch' => \&listjobs,
  'PUT:/jobs/$arch/$job' => \&addjob,
  'POST:/jobs/$arch/$job cmd=idleworker workerid jobid?' => \&idleworkerjob,
  'POST:/jobs/$arch/$job cmd=setdispatchdetails details:?' => \&setdispatchdetails,
  'POST:/jobs/$arch/$job cmd=fail message:' => \&failjob,
  'DELETE:/jobs/$arch/$job' => \&deljob,
  '/jobs/$arch/$job view:?' => \&getjob,

  # info
  '/workerstatus daemonsonly:bool? arch* type:*' => \&workerstatus,

  # registry
  'GET|HEAD:/registry/$gunprefix:/$...:regrepo/_trust/tuf/$filename' => \&registry_tuf,
  'GET|HEAD:/registry/$...:regrepo/manifests/$manifest:' => \&registry_manifest,
  'GET|HEAD:/registry/$...:regrepo/blobs/$blob:' => \&registry_blob,
  'GET|HEAD:/registry/$...:regrepo/signatures/$sig:' => \&registry_sigstore,
  'GET|HEAD:/registry/$...:regrepo/referrers/$subject: artifactType:?' => \&registry_referrers,
  'GET|HEAD:/registry/$...:regrepo/manifestinfos/$manifest:' => \&registry_manifestinfo,
  'GET|HEAD:/registry/$...:regrepo/tags/list n:intnum? last:?' => \&registry_taglist,
  'GET|HEAD:/registry/$...:regrepo/info.json' => \&registry_info,
  'GET|HEAD:/registry/_catalog' => \&registry_catalog,
  'GET|HEAD:/registry' => \&registry_version,

  # slsa
  'POST:/slsa cmd=addrefs $prpa' => \&slsa_addrefs,
  '/slsa/$project/$repository/$arch/$filename/$digest: view:?' => \&slsa_getfile,

  # configuration
  'PUT:/configuration' => \&putconfiguration,
  '/configuration' => \&getconfiguration,

  '/_result $prpa+ oldstate:md5? package* code:* lastbuild:bool? withbinarylist:bool? withstats:bool? withinfo:bool? summary:bool? withversrel:bool?' => \&getresult,
  '/_jobhistory $prpa+ package* code:* limit:num? endtime_start:num? endtime_end:num?' => \&getjobhistory_project,
  'POST:/_command $cmd: $prpa+ package* code:* lastbuild:bool? sysrq:? allarch:bool?' => \&docommand,

  '/serverstatus' => \&BSStdServer::serverstatus,
  '/ajaxstatus aidx=all' => \&getajaxstatuslist,
  '/ajaxstatus aidx:num?' => \&getajaxstatus,
];

my $dispatches_ajax = [
  '/' => \&hello,
  '/ajaxstatus' => \&getajaxstatus,
  '/build/$project/$repository/$arch/$package/_log nostream:bool? last:bool? lastsucceeded:bool? start:intnum? end:num? view:?' => \&getlogfile,
  '/build/$project/$repository/$arch/$package:package_repository view:? binary:filename* nometa:bool? nosource:bool? module* withccache:bool?' => \&getbinarylist,
  '/build/$project/$repository/$arch/$package:package_repository/$filename view:? withfilelist:bool? module*' => \&getbinary,
  '/_result $prpa+ oldstate:md5? package* code:* withbinarylist:bool? withstats:bool? withinfo:bool? summary:bool? withversrel:bool?' => \&getresult,
  '/getbinaries $project $repository $arch binaries: nometa:bool? metaonly:bool? now:num? module* withannotation:bool?' => \&getbinaries,
  '/getbinaryversions $project $repository $arch binaries: nometa:bool? now:num? module* withevr:bool?' => \&getbinaryversions,
];

my $conf = {
  'runname' => 'bs_repserver',
  'port' => $port,
  'proto' => $proto,
  'dispatches' => $dispatches,
  'memoize' => "$eventdir/memoize",
  'memoize_max_size' => 1024*1024, # 1MB in bytes
  'maxchild' => 20,
  'maxchild2' => 20,
  'slowrequestthr' => 10,
  'errorreply' => \&BSRegistryServer::errreply,
};

my $aconf = {
  'socketpath' => $ajaxsocket,
  'dispatches' => $dispatches_ajax,
  'slowrequestthr' => 300,
};

$aconf->{'partitions'} = $BSConfig::reposerver_ajaxpartitions if $BSConfig::reposerver_ajaxpartitions;

if ($BSConfig::workerreposerver) {
  my $wport = $port;
  $wport = $1 if $BSConfig::workerreposerver =~ /:(\d+)$/;
  $conf->{'port2'} = $wport if $wport != $port;
  my $wproto = 'http';
  $wproto = $1 if $BSConfig::workerreposerver =~ /^(https):/;
  die("worker port on $wproto but normal port on $proto: both need to be the same\n") unless $wproto eq $proto;
}
%$conf = (%$conf, %{$BSConfig::reposerver_extraconf}) if $BSConfig::reposerver_extraconf;

# create bsdir before root privileges are dropped
BSUtil::mkdir_p_chown($BSConfig::bsdir, $BSConfig::bsuser, $BSConfig::bsgroup);
BSStdServer::setup_authenticator();
BSStdServer::server('rep_server', \@ARGV, $conf, $aconf);
